source: git/Singular/iparith.cc @ ede2ad8

spielwiese
Last change on this file since ede2ad8 was ede2ad8, checked in by Hans Schoenemann <hannes@…>, 8 years ago
fix tr. #712: std(SB,I) does not allow crit3 because of the (wrong) order of reductions if size(I)*4 > 3*size(SB), use std(SB+I), otherwise disable crit3
  • Property mode set to 100644
File size: 225.5 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) in *",
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  int i=(int)(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    if (nMap==NULL)
1831    {
1832      Werror("not implemented: map bigint -> %s", nCoeffString(cf));
1833      return TRUE;
1834    }
1835    xx=(number *)omAlloc(rl*sizeof(number));
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) &&(result!=NULL))
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 result==NULL;
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  if (strcmp(s,"try")==0)
2670    return jjLOAD_TRY((char*)v->Data());
2671  WerrorS("invalid second argument");
2672  WerrorS("load(\"libname\" [,option]);");
2673  return TRUE;
2674}
2675static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2676{
2677  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2678  tHomog hom=testHomog;
2679  if (w_u!=NULL)
2680  {
2681    w_u=ivCopy(w_u);
2682    hom=isHomog;
2683  }
2684  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2685  if (w_v!=NULL)
2686  {
2687    w_v=ivCopy(w_v);
2688    hom=isHomog;
2689  }
2690  if ((w_u!=NULL) && (w_v==NULL))
2691    w_v=ivCopy(w_u);
2692  if ((w_v!=NULL) && (w_u==NULL))
2693    w_u=ivCopy(w_v);
2694  ideal u_id=(ideal)u->Data();
2695  ideal v_id=(ideal)v->Data();
2696  if (w_u!=NULL)
2697  {
2698     if ((*w_u).compare((w_v))!=0)
2699     {
2700       WarnS("incompatible weights");
2701       delete w_u; w_u=NULL;
2702       hom=testHomog;
2703     }
2704     else
2705     {
2706       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
2707       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
2708       {
2709         WarnS("wrong weights");
2710         delete w_u; w_u=NULL;
2711         hom=testHomog;
2712       }
2713     }
2714  }
2715  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2716  if (w_u!=NULL)
2717  {
2718    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2719  }
2720  delete w_v;
2721  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2722  return FALSE;
2723}
2724static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2725{
2726  number q=(number)v->Data();
2727  if (n_IsZero(q,coeffs_BIGINT))
2728  {
2729    WerrorS(ii_div_by_0);
2730    return TRUE;
2731  }
2732  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2733  return FALSE;
2734}
2735static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2736{
2737  number q=(number)v->Data();
2738  if (nIsZero(q))
2739  {
2740    WerrorS(ii_div_by_0);
2741    return TRUE;
2742  }
2743  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2744  return FALSE;
2745}
2746static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2747static BOOLEAN jjMONITOR1(leftv res, leftv v)
2748{
2749  return jjMONITOR2(res,v,NULL);
2750}
2751static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2752{
2753#if 0
2754  char *opt=(char *)v->Data();
2755  int mode=0;
2756  while(*opt!='\0')
2757  {
2758    if (*opt=='i') mode |= SI_PROT_I;
2759    else if (*opt=='o') mode |= SI_PROT_O;
2760    opt++;
2761  }
2762  monitor((char *)(u->Data()),mode);
2763#else
2764  si_link l=(si_link)u->Data();
2765  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2766  if(strcmp(l->m->type,"ASCII")!=0)
2767  {
2768    Werror("ASCII link required, not `%s`",l->m->type);
2769    slClose(l);
2770    return TRUE;
2771  }
2772  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2773  if ( l->name[0]!='\0') // "" is the stop condition
2774  {
2775    const char *opt;
2776    int mode=0;
2777    if (v==NULL) opt=(const char*)"i";
2778    else         opt=(const char *)v->Data();
2779    while(*opt!='\0')
2780    {
2781      if (*opt=='i') mode |= SI_PROT_I;
2782      else if (*opt=='o') mode |= SI_PROT_O;
2783      opt++;
2784    }
2785    monitor((FILE *)l->data,mode);
2786  }
2787  else
2788    monitor(NULL,0);
2789  return FALSE;
2790#endif
2791}
2792static BOOLEAN jjMONOM(leftv res, leftv v)
2793{
2794  intvec *iv=(intvec *)v->Data();
2795  poly p=pOne();
2796  int i,e;
2797  BOOLEAN err=FALSE;
2798  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2799  {
2800    e=(*iv)[i-1];
2801    if (e>=0) pSetExp(p,i,e);
2802    else err=TRUE;
2803  }
2804  if (iv->length()==(currRing->N+1))
2805  {
2806    res->rtyp=VECTOR_CMD;
2807    e=(*iv)[currRing->N];
2808    if (e>=0) pSetComp(p,e);
2809    else err=TRUE;
2810  }
2811  pSetm(p);
2812  res->data=(char*)p;
2813  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2814  return err;
2815}
2816static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2817{
2818  // u: the name of the new type
2819  // v: the elements
2820  newstruct_desc d=newstructFromString((const char *)v->Data());
2821  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2822  return d==NULL;
2823}
2824static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2825{
2826  idhdl h=(idhdl)u->data;
2827  int i=(int)(long)v->Data();
2828  int p=0;
2829  if ((0<i)
2830  && (rParameter(IDRING(h))!=NULL)
2831  && (i<=(p=rPar(IDRING(h)))))
2832    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2833  else
2834  {
2835    Werror("par number %d out of range 1..%d",i,p);
2836    return TRUE;
2837  }
2838  return FALSE;
2839}
2840#ifdef HAVE_PLURAL
2841static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2842{
2843  if( currRing->qideal != NULL )
2844  {
2845    WerrorS("basering must NOT be a qring!");
2846    return TRUE;
2847  }
2848
2849  if (iiOp==NCALGEBRA_CMD)
2850  {
2851    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2852  }
2853  else
2854  {
2855    ring r=rCopy(currRing);
2856    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2857    res->data=r;
2858    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2859    return result;
2860  }
2861}
2862static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2863{
2864  if( currRing->qideal != NULL )
2865  {
2866    WerrorS("basering must NOT be a qring!");
2867    return TRUE;
2868  }
2869
2870  if (iiOp==NCALGEBRA_CMD)
2871  {
2872    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2873  }
2874  else
2875  {
2876    ring r=rCopy(currRing);
2877    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2878    res->data=r;
2879    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2880    return result;
2881  }
2882}
2883static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2884{
2885  if( currRing->qideal != NULL )
2886  {
2887    WerrorS("basering must NOT be a qring!");
2888    return TRUE;
2889  }
2890
2891  if (iiOp==NCALGEBRA_CMD)
2892  {
2893    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2894  }
2895  else
2896  {
2897    ring r=rCopy(currRing);
2898    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2899    res->data=r;
2900    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2901    return result;
2902  }
2903}
2904static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2905{
2906  if( currRing->qideal != NULL )
2907  {
2908    WerrorS("basering must NOT be a qring!");
2909    return TRUE;
2910  }
2911
2912  if (iiOp==NCALGEBRA_CMD)
2913  {
2914    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2915  }
2916  else
2917  {
2918    ring r=rCopy(currRing);
2919    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2920    res->data=r;
2921    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2922    return result;
2923  }
2924}
2925static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2926{
2927  res->data=NULL;
2928
2929  if (rIsPluralRing(currRing))
2930  {
2931    const poly q = (poly)b->Data();
2932
2933    if( q != NULL )
2934    {
2935      if( (poly)a->Data() != NULL )
2936      {
2937        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2938        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2939      }
2940    }
2941  }
2942  return FALSE;
2943}
2944static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2945{
2946  /* number, poly, vector, ideal, module, matrix */
2947  ring  r = (ring)a->Data();
2948  if (r == currRing)
2949  {
2950    res->data = b->Data();
2951    res->rtyp = b->rtyp;
2952    return FALSE;
2953  }
2954  if (!rIsLikeOpposite(currRing, r))
2955  {
2956    Werror("%s is not an opposite ring to current ring",a->Fullname());
2957    return TRUE;
2958  }
2959  idhdl w;
2960  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2961  {
2962    int argtype = IDTYP(w);
2963    switch (argtype)
2964    {
2965    case NUMBER_CMD:
2966      {
2967        /* since basefields are equal, we can apply nCopy */
2968        res->data = nCopy((number)IDDATA(w));
2969        res->rtyp = argtype;
2970        break;
2971      }
2972    case POLY_CMD:
2973    case VECTOR_CMD:
2974      {
2975        poly    q = (poly)IDDATA(w);
2976        res->data = pOppose(r,q,currRing);
2977        res->rtyp = argtype;
2978        break;
2979      }
2980    case IDEAL_CMD:
2981    case MODUL_CMD:
2982      {
2983        ideal   Q = (ideal)IDDATA(w);
2984        res->data = idOppose(r,Q,currRing);
2985        res->rtyp = argtype;
2986        break;
2987      }
2988    case MATRIX_CMD:
2989      {
2990        ring save = currRing;
2991        rChangeCurrRing(r);
2992        matrix  m = (matrix)IDDATA(w);
2993        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2994        rChangeCurrRing(save);
2995        ideal   S = idOppose(r,Q,currRing);
2996        id_Delete(&Q, r);
2997        res->data = id_Module2Matrix(S,currRing);
2998        res->rtyp = argtype;
2999        break;
3000      }
3001    default:
3002      {
3003        WerrorS("unsupported type in oppose");
3004        return TRUE;
3005      }
3006    }
3007  }
3008  else
3009  {
3010    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
3011    return TRUE;
3012  }
3013  return FALSE;
3014}
3015#endif /* HAVE_PLURAL */
3016
3017static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
3018{
3019  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
3020    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
3021  id_DelMultiples((ideal)(res->data),currRing);
3022  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
3023  return FALSE;
3024}
3025static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
3026{
3027  int i=(int)(long)u->Data();
3028  int j=(int)(long)v->Data();
3029  if (j-i <0) {WerrorS("invalid range for random"); return TRUE;}
3030  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
3031  return FALSE;
3032}
3033static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
3034{
3035  matrix m =(matrix)u->Data();
3036  int isRowEchelon = (int)(long)v->Data();
3037  if (isRowEchelon != 1) isRowEchelon = 0;
3038  int rank = luRank(m, isRowEchelon);
3039  res->data =(char *)(long)rank;
3040  return FALSE;
3041}
3042static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
3043{
3044  si_link l=(si_link)u->Data();
3045  leftv r=slRead(l,v);
3046  if (r==NULL)
3047  {
3048    const char *s;
3049    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3050    else                            s=sNoName;
3051    Werror("cannot read from `%s`",s);
3052    return TRUE;
3053  }
3054  memcpy(res,r,sizeof(sleftv));
3055  omFreeBin((ADDRESS)r, sleftv_bin);
3056  return FALSE;
3057}
3058static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
3059{
3060  ideal vi=(ideal)v->Data();
3061  if (currRing->qideal!=NULL || vi->ncols>1 || rIsPluralRing(currRing))
3062    assumeStdFlag(v);
3063  res->data = (char *)kNF(vi,currRing->qideal,(poly)u->Data());
3064  return FALSE;
3065}
3066static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
3067{
3068  ideal ui=(ideal)u->Data();
3069  ideal vi=(ideal)v->Data();
3070  if (currRing->qideal!=NULL || vi->ncols>1 || rIsPluralRing(currRing))
3071    assumeStdFlag(v);
3072  res->data = (char *)kNF(vi,currRing->qideal,ui);
3073  return FALSE;
3074}
3075#if 0
3076static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3077{
3078  int maxl=(int)(long)v->Data();
3079  if (maxl<0)
3080  {
3081    WerrorS("length for res must not be negative");
3082    return TRUE;
3083  }
3084  int l=0;
3085  //resolvente r;
3086  syStrategy r;
3087  intvec *weights=NULL;
3088  int wmaxl=maxl;
3089  ideal u_id=(ideal)u->Data();
3090
3091  maxl--;
3092  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3093  {
3094    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3095    if (currRing->qideal!=NULL)
3096    {
3097      Warn(
3098      "full resolution in a qring may be infinite, setting max length to %d",
3099      maxl+1);
3100    }
3101  }
3102  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3103  if (weights!=NULL)
3104  {
3105    if (!idTestHomModule(u_id,currRing->qideal,weights))
3106    {
3107      WarnS("wrong weights given:");weights->show();PrintLn();
3108      weights=NULL;
3109    }
3110  }
3111  intvec *ww=NULL;
3112  int add_row_shift=0;
3113  if (weights!=NULL)
3114  {
3115     ww=ivCopy(weights);
3116     add_row_shift = ww->min_in();
3117     (*ww) -= add_row_shift;
3118  }
3119  else
3120    idHomModule(u_id,currRing->qideal,&ww);
3121  weights=ww;
3122
3123  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3124  {
3125    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3126  }
3127  else if (iiOp==SRES_CMD)
3128  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3129    r=sySchreyer(u_id,maxl+1);
3130  else if (iiOp == LRES_CMD)
3131  {
3132    int dummy;
3133    if((currRing->qideal!=NULL)||
3134    (!idHomIdeal (u_id,NULL)))
3135    {
3136       WerrorS
3137       ("`lres` not implemented for inhomogeneous input or qring");
3138       return TRUE;
3139    }
3140    r=syLaScala3(u_id,&dummy);
3141  }
3142  else if (iiOp == KRES_CMD)
3143  {
3144    int dummy;
3145    if((currRing->qideal!=NULL)||
3146    (!idHomIdeal (u_id,NULL)))
3147    {
3148       WerrorS
3149       ("`kres` not implemented for inhomogeneous input or qring");
3150       return TRUE;
3151    }
3152    r=syKosz(u_id,&dummy);
3153  }
3154  else
3155  {
3156    int dummy;
3157    if((currRing->qideal!=NULL)||
3158    (!idHomIdeal (u_id,NULL)))
3159    {
3160       WerrorS
3161       ("`hres` not implemented for inhomogeneous input or qring");
3162       return TRUE;
3163    }
3164    r=syHilb(u_id,&dummy);
3165  }
3166  if (r==NULL) return TRUE;
3167  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3168  r->list_length=wmaxl;
3169  res->data=(void *)r;
3170  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3171  {
3172    intvec *w=ivCopy(r->weights[0]);
3173    if (weights!=NULL) (*w) += add_row_shift;
3174    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3175    w=NULL;
3176  }
3177  else
3178  {
3179//#if 0
3180// need to set weights for ALL components (sres)
3181    if (weights!=NULL)
3182    {
3183      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3184      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3185      (r->weights)[0] = ivCopy(weights);
3186    }
3187//#endif
3188  }
3189  if (ww!=NULL) { delete ww; ww=NULL; }
3190  return FALSE;
3191}
3192#else
3193static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3194{
3195  int maxl=(int)(long)v->Data();
3196  if (maxl<0)
3197  {
3198    WerrorS("length for res must not be negative");
3199    return TRUE;
3200  }
3201  syStrategy r;
3202  intvec *weights=NULL;
3203  int wmaxl=maxl;
3204  ideal u_id=(ideal)u->Data();
3205
3206  maxl--;
3207  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3208  {
3209    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3210    if (currRing->qideal!=NULL)
3211    {
3212      Warn(
3213      "full resolution in a qring may be infinite, setting max length to %d",
3214      maxl+1);
3215    }
3216  }
3217  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3218  if (weights!=NULL)
3219  {
3220    if (!idTestHomModule(u_id,currRing->qideal,weights))
3221    {
3222      WarnS("wrong weights given:");weights->show();PrintLn();
3223      weights=NULL;
3224    }
3225  }
3226  intvec *ww=NULL;
3227  int add_row_shift=0;
3228  if (weights!=NULL)
3229  {
3230     ww=ivCopy(weights);
3231     add_row_shift = ww->min_in();
3232     (*ww) -= add_row_shift;
3233  }
3234  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3235  {
3236    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3237  }
3238  else if (iiOp==SRES_CMD)
3239  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3240    r=sySchreyer(u_id,maxl+1);
3241  else if (iiOp == LRES_CMD)
3242  {
3243    int dummy;
3244    if((currRing->qideal!=NULL)||
3245    (!idHomIdeal (u_id,NULL)))
3246    {
3247       WerrorS
3248       ("`lres` not implemented for inhomogeneous input or qring");
3249       return TRUE;
3250    }
3251    if(currRing->N == 1)
3252      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3253    r=syLaScala3(u_id,&dummy);
3254  }
3255  else if (iiOp == KRES_CMD)
3256  {
3257    int dummy;
3258    if((currRing->qideal!=NULL)||
3259    (!idHomIdeal (u_id,NULL)))
3260    {
3261       WerrorS
3262       ("`kres` not implemented for inhomogeneous input or qring");
3263       return TRUE;
3264    }
3265    r=syKosz(u_id,&dummy);
3266  }
3267  else
3268  {
3269    int dummy;
3270    if((currRing->qideal!=NULL)||
3271    (!idHomIdeal (u_id,NULL)))
3272    {
3273       WerrorS
3274       ("`hres` not implemented for inhomogeneous input or qring");
3275       return TRUE;
3276    }
3277    ideal u_id_copy=idCopy(u_id);
3278    idSkipZeroes(u_id_copy);
3279    r=syHilb(u_id_copy,&dummy);
3280    idDelete(&u_id_copy);
3281  }
3282  if (r==NULL) return TRUE;
3283  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3284  r->list_length=wmaxl;
3285  res->data=(void *)r;
3286  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3287  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3288  {
3289    ww=ivCopy(r->weights[0]);
3290    if (weights!=NULL) (*ww) += add_row_shift;
3291    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3292  }
3293  else
3294  {
3295    if (weights!=NULL)
3296    {
3297      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3298    }
3299  }
3300
3301  // test the La Scala case' output
3302  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3303  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3304
3305  if(iiOp != HRES_CMD)
3306    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3307  else
3308    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3309
3310  return FALSE;
3311}
3312#endif
3313static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3314{
3315  number n1; int i;
3316
3317  if ((u->Typ() == BIGINT_CMD) ||
3318     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3319  {
3320    n1 = (number)u->CopyD();
3321  }
3322  else if (u->Typ() == INT_CMD)
3323  {
3324    i = (int)(long)u->Data();
3325    n1 = n_Init(i, coeffs_BIGINT);
3326  }
3327  else
3328  {
3329    return TRUE;
3330  }
3331
3332  i = (int)(long)v->Data();
3333
3334  lists l = primeFactorisation(n1, i);
3335  n_Delete(&n1, coeffs_BIGINT);
3336  res->data = (char*)l;
3337  return FALSE;
3338}
3339static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3340{
3341  ring r;
3342  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3343  res->data = (char *)r;
3344  return (i==-1);
3345}
3346#define SIMPL_LMDIV 32
3347#define SIMPL_LMEQ  16
3348#define SIMPL_MULT 8
3349#define SIMPL_EQU  4
3350#define SIMPL_NULL 2
3351#define SIMPL_NORM 1
3352static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3353{
3354  int sw = (int)(long)v->Data();
3355  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3356  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3357  if (sw & SIMPL_LMDIV)
3358  {
3359    id_DelDiv(id,currRing);
3360  }
3361  if (sw & SIMPL_LMEQ)
3362  {
3363    id_DelLmEquals(id,currRing);
3364  }
3365  if (sw & SIMPL_MULT)
3366  {
3367    id_DelMultiples(id,currRing);
3368  }
3369  else if(sw & SIMPL_EQU)
3370  {
3371    id_DelEquals(id,currRing);
3372  }
3373  if (sw & SIMPL_NULL)
3374  {
3375    idSkipZeroes(id);
3376  }
3377  if (sw & SIMPL_NORM)
3378  {
3379    id_Norm(id,currRing);
3380  }
3381  res->data = (char * )id;
3382  return FALSE;
3383}
3384extern int singclap_factorize_retry;
3385static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3386{
3387  intvec *v=NULL;
3388  int sw=(int)(long)dummy->Data();
3389  int fac_sw=sw;
3390  if (sw<0) fac_sw=1;
3391  singclap_factorize_retry=0;
3392  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3393  if (f==NULL)
3394    return TRUE;
3395  switch(sw)
3396  {
3397    case 0:
3398    case 2:
3399    {
3400      lists l=(lists)omAllocBin(slists_bin);
3401      l->Init(2);
3402      l->m[0].rtyp=IDEAL_CMD;
3403      l->m[0].data=(void *)f;
3404      l->m[1].rtyp=INTVEC_CMD;
3405      l->m[1].data=(void *)v;
3406      res->data=(void *)l;
3407      res->rtyp=LIST_CMD;
3408      return FALSE;
3409    }
3410    case 1:
3411      res->data=(void *)f;
3412      return FALSE;
3413    case 3:
3414      {
3415        poly p=f->m[0];
3416        int i=IDELEMS(f);
3417        f->m[0]=NULL;
3418        while(i>1)
3419        {
3420          i--;
3421          p=pMult(p,f->m[i]);
3422          f->m[i]=NULL;
3423        }
3424        res->data=(void *)p;
3425        res->rtyp=POLY_CMD;
3426      }
3427      return FALSE;
3428  }
3429  WerrorS("invalid switch");
3430  return FALSE;
3431}
3432static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3433{
3434  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3435  return FALSE;
3436}
3437static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3438{
3439  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3440  //return (res->data== (void*)(long)-2);
3441  return FALSE;
3442}
3443static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3444{
3445  int sw = (int)(long)v->Data();
3446  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3447  poly p = (poly)u->CopyD(POLY_CMD);
3448  if (sw & SIMPL_NORM)
3449  {
3450    pNorm(p);
3451  }
3452  res->data = (char * )p;
3453  return FALSE;
3454}
3455static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3456{
3457  ideal result;
3458  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3459  tHomog hom=testHomog;
3460  ideal u_id=(ideal)(u->Data());
3461  if (w!=NULL)
3462  {
3463    if (!idTestHomModule(u_id,currRing->qideal,w))
3464    {
3465      WarnS("wrong weights:");w->show();PrintLn();
3466      w=NULL;
3467    }
3468    else
3469    {
3470      w=ivCopy(w);
3471      hom=isHomog;
3472    }
3473  }
3474  result=kStd(u_id,currRing->qideal,hom,&w,(intvec *)v->Data());
3475  idSkipZeroes(result);
3476  res->data = (char *)result;
3477  setFlag(res,FLAG_STD);
3478  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3479  return FALSE;
3480}
3481static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3482{
3483  ideal result;
3484  assumeStdFlag(u);
3485  ideal i1=(ideal)(u->Data());
3486  ideal i0;
3487  int r=v->Typ();
3488  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3489  {
3490    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3491    i0->m[0]=(poly)v->Data();
3492    int ii0=idElem(i0); /* size of i0 */
3493    i1=idSimpleAdd(i1,i0); //
3494    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3495    idDelete(&i0);
3496    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3497    tHomog hom=testHomog;
3498
3499    if (w!=NULL)
3500    {
3501      if (!idTestHomModule(i1,currRing->qideal,w))
3502      {
3503        // no warnung: this is legal, if i in std(i,p)
3504        // is homogeneous, but p not
3505        w=NULL;
3506      }
3507      else
3508      {
3509        w=ivCopy(w);
3510        hom=isHomog;
3511      }
3512    }
3513    BITSET save1;
3514    SI_SAVE_OPT1(save1);
3515    si_opt_1|=Sy_bit(OPT_SB_1);
3516    /* ii0 appears to be the position of the first element of il that
3517       does not belong to the old SB ideal */
3518    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii0);
3519    SI_RESTORE_OPT1(save1);
3520    idDelete(&i1);
3521    idSkipZeroes(result);
3522    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3523    res->data = (char *)result;
3524  }
3525  else /*IDEAL/MODULE*/
3526  {
3527    i0=(ideal)v->CopyD();
3528    int ii0=idElem(i0); /* size of i0 */
3529    i1=idSimpleAdd(i1,i0); //
3530    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3531    idDelete(&i0);
3532    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3533    tHomog hom=testHomog;
3534
3535    if (w!=NULL)
3536    {
3537      if (!idTestHomModule(i1,currRing->qideal,w))
3538      {
3539        // no warnung: this is legal, if i in std(i,p)
3540        // is homogeneous, but p not
3541        w=NULL;
3542      }
3543      else
3544      {
3545        w=ivCopy(w);
3546        hom=isHomog;
3547      }
3548    }
3549    if (ii0*4 >= 3*IDELEMS(i1)) // MAGIC: add few poly to large SB: 3/4
3550    {
3551      BITSET save1;
3552      SI_SAVE_OPT1(save1);
3553      si_opt_1|=Sy_bit(OPT_SB_1);
3554      /* ii0 appears to be the position of the first element of il that
3555       does not belong to the old SB ideal */
3556      result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii0);
3557      SI_RESTORE_OPT1(save1);
3558    }
3559    else
3560    {
3561      result=kStd(i1,currRing->qideal,hom,&w);
3562    }
3563    idDelete(&i1);
3564    idSkipZeroes(result);
3565    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3566    res->data = (char *)result;
3567  }
3568  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3569  return FALSE;
3570}
3571static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3572{
3573  idhdl h=(idhdl)u->data;
3574  int i=(int)(long)v->Data();
3575  if ((0<i) && (i<=IDRING(h)->N))
3576    res->data=omStrDup(IDRING(h)->names[i-1]);
3577  else
3578  {
3579    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3580    return TRUE;
3581  }
3582  return FALSE;
3583}
3584static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3585{
3586// input: u: a list with links of type
3587//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3588//        v: timeout for select in milliseconds
3589//           or 0 for polling
3590// returns: ERROR (via Werror): timeout negative
3591//           -1: the read state of all links is eof
3592//            0: timeout (or polling): none ready
3593//           i>0: (at least) L[i] is ready
3594  lists Lforks = (lists)u->Data();
3595  int t = (int)(long)v->Data();
3596  if(t < 0)
3597  {
3598    WerrorS("negative timeout"); return TRUE;
3599  }
3600  int i = slStatusSsiL(Lforks, t*1000);
3601  if(i == -2) /* error */
3602  {
3603    return TRUE;
3604  }
3605  res->data = (void*)(long)i;
3606  return FALSE;
3607}
3608static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3609{
3610// input: u: a list with links of type
3611//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3612//        v: timeout for select in milliseconds
3613//           or 0 for polling
3614// returns: ERROR (via Werror): timeout negative
3615//           -1: the read state of all links is eof
3616//           0: timeout (or polling): none ready
3617//           1: all links are ready
3618//              (caution: at least one is ready, but some maybe dead)
3619  lists Lforks = (lists)u->CopyD();
3620  int timeout = 1000*(int)(long)v->Data();
3621  if(timeout < 0)
3622  {
3623    WerrorS("negative timeout"); return TRUE;
3624  }
3625  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3626  int i;
3627  int ret = -1;
3628  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3629  {
3630    i = slStatusSsiL(Lforks, timeout);
3631    if(i > 0) /* Lforks[i] is ready */
3632    {
3633      ret = 1;
3634      Lforks->m[i-1].CleanUp();
3635      Lforks->m[i-1].rtyp=DEF_CMD;
3636      Lforks->m[i-1].data=NULL;
3637      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3638    }
3639    else /* terminate the for loop */
3640    {
3641      if(i == -2) /* error */
3642      {
3643        return TRUE;
3644      }
3645      if(i == 0) /* timeout */
3646      {
3647        ret = 0;
3648      }
3649      break;
3650    }
3651  }
3652  Lforks->Clean();
3653  res->data = (void*)(long)ret;
3654  return FALSE;
3655}
3656static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3657{
3658  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3659  return FALSE;
3660}
3661#define jjWRONG2 (proc2)jjWRONG
3662#define jjWRONG3 (proc3)jjWRONG
3663static BOOLEAN jjWRONG(leftv, leftv)
3664{
3665  return TRUE;
3666}
3667
3668/*=================== operations with 1 arg.: static proc =================*/
3669/* must be ordered: first operations for chars (infix ops),
3670 * then alphabetically */
3671
3672static BOOLEAN jjDUMMY(leftv res, leftv u)
3673{
3674  res->data = (char *)u->CopyD();
3675  return FALSE;
3676}
3677static BOOLEAN jjNULL(leftv, leftv)
3678{
3679  return FALSE;
3680}
3681//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3682//{
3683//  res->data = (char *)((int)(long)u->Data()+1);
3684//  return FALSE;
3685//}
3686//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3687//{
3688//  res->data = (char *)((int)(long)u->Data()-1);
3689//  return FALSE;
3690//}
3691static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3692{
3693  if (IDTYP((idhdl)u->data)==INT_CMD)
3694  {
3695    int i=IDINT((idhdl)u->data);
3696    if (iiOp==PLUSPLUS) i++;
3697    else                i--;
3698    IDDATA((idhdl)u->data)=(char *)(long)i;
3699    return FALSE;
3700  }
3701  return TRUE;
3702}
3703static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3704{
3705  number n=(number)u->CopyD(BIGINT_CMD);
3706  n=n_InpNeg(n,coeffs_BIGINT);
3707  res->data = (char *)n;
3708  return FALSE;
3709}
3710static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3711{
3712  res->data = (char *)(-(long)u->Data());
3713  return FALSE;
3714}
3715static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3716{
3717  number n=(number)u->CopyD(NUMBER_CMD);
3718  n=nInpNeg(n);
3719  res->data = (char *)n;
3720  return FALSE;
3721}
3722static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3723{
3724  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3725  return FALSE;
3726}
3727static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3728{
3729  poly m1=pISet(-1);
3730  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3731  return FALSE;
3732}
3733static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3734{
3735  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3736  (*iv)*=(-1);
3737  res->data = (char *)iv;
3738  return FALSE;
3739}
3740static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3741{
3742  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3743  (*bim)*=(-1);
3744  res->data = (char *)bim;
3745  return FALSE;
3746}
3747static BOOLEAN jjPROC1(leftv res, leftv u)
3748{
3749  return jjPROC(res,u,NULL);
3750}
3751static BOOLEAN jjBAREISS(leftv res, leftv v)
3752{
3753  //matrix m=(matrix)v->Data();
3754  //lists l=mpBareiss(m,FALSE);
3755  intvec *iv;
3756  ideal m;
3757  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3758  lists l=(lists)omAllocBin(slists_bin);
3759  l->Init(2);
3760  l->m[0].rtyp=MODUL_CMD;
3761  l->m[1].rtyp=INTVEC_CMD;
3762  l->m[0].data=(void *)m;
3763  l->m[1].data=(void *)iv;
3764  res->data = (char *)l;
3765  return FALSE;
3766}
3767//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3768//{
3769//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3770//  ivTriangMat(m);
3771//  res->data = (char *)m;
3772//  return FALSE;
3773//}
3774static BOOLEAN jjBI2N(leftv res, leftv u)
3775{
3776  BOOLEAN bo=FALSE;
3777  number n=(number)u->CopyD();
3778  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3779  if (nMap!=NULL)
3780    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3781  else
3782  {
3783    Werror("cannot convert bigint to cring %s", nCoeffString(currRing->cf));
3784    bo=TRUE;
3785  }
3786  n_Delete(&n,coeffs_BIGINT);
3787  return bo;
3788}
3789static BOOLEAN jjBI2P(leftv res, leftv u)
3790{
3791  sleftv tmp;
3792  BOOLEAN bo=jjBI2N(&tmp,u);
3793  if (!bo)
3794  {
3795    number n=(number) tmp.data;
3796    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3797    else
3798    {
3799      res->data=(void *)pNSet(n);
3800    }
3801  }
3802  return bo;
3803}
3804static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3805{
3806  return iiExprArithM(res,u,iiOp);
3807}
3808static BOOLEAN jjCHAR(leftv res, leftv v)
3809{
3810  res->data = (char *)(long)rChar((ring)v->Data());
3811  return FALSE;
3812}
3813static BOOLEAN jjCOLS(leftv res, leftv v)
3814{
3815  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3816  return FALSE;
3817}
3818static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3819{
3820  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3821  return FALSE;
3822}
3823static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3824{
3825  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3826  return FALSE;
3827}
3828static BOOLEAN jjCONTENT(leftv res, leftv v)
3829{
3830  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3831  poly p=(poly)v->CopyD(POLY_CMD);
3832  if (p!=NULL) p_Cleardenom(p, currRing);
3833  res->data = (char *)p;
3834  return FALSE;
3835}
3836static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3837{
3838  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3839  return FALSE;
3840}
3841static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3842{
3843  res->data = (char *)(long)nSize((number)v->Data());
3844  return FALSE;
3845}
3846static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3847{
3848  lists l=(lists)v->Data();
3849  res->data = (char *)(long)(lSize(l)+1);
3850  return FALSE;
3851}
3852static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3853{
3854  matrix m=(matrix)v->Data();
3855  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3856  return FALSE;
3857}
3858static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3859{
3860  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3861  return FALSE;
3862}
3863static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3864{
3865  ring r=(ring)v->Data();
3866  int elems=-1;
3867  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3868  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3869  {
3870    extern int ipower ( int b, int n ); /* factory/cf_util */
3871    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3872  }
3873  res->data = (char *)(long)elems;
3874  return FALSE;
3875}
3876static BOOLEAN jjDEG(leftv res, leftv v)
3877{
3878  int dummy;
3879  poly p=(poly)v->Data();
3880  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3881  else res->data=(char *)-1;
3882  return FALSE;
3883}
3884static BOOLEAN jjDEG_M(leftv res, leftv u)
3885{
3886  ideal I=(ideal)u->Data();
3887  int d=-1;
3888  int dummy;
3889  int i;
3890  for(i=IDELEMS(I)-1;i>=0;i--)
3891    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3892  res->data = (char *)(long)d;
3893  return FALSE;
3894}
3895static BOOLEAN jjDEGREE(leftv res, leftv v)
3896{
3897  SPrintStart();
3898#ifdef HAVE_RINGS
3899  if (rField_is_Ring_Z(currRing))
3900  {
3901    ring origR = currRing;
3902    ring tempR = rCopy(origR);
3903    coeffs new_cf=nInitChar(n_Q,NULL);
3904    nKillChar(tempR->cf);
3905    tempR->cf=new_cf;
3906    rComplete(tempR);
3907    ideal vid = (ideal)v->Data();
3908    rChangeCurrRing(tempR);
3909    ideal vv = idrCopyR(vid, origR, currRing);
3910    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3911    vvAsLeftv.rtyp = IDEAL_CMD;
3912    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3913    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3914    assumeStdFlag(&vvAsLeftv);
3915    Print("// NOTE: computation of degree is being performed for\n");
3916    Print("//       generic fibre, that is, over Q\n");
3917    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3918    scDegree(vv,module_w,currRing->qideal);
3919    idDelete(&vv);
3920    rChangeCurrRing(origR);
3921    rDelete(tempR);
3922  }
3923#endif
3924  assumeStdFlag(v);
3925  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3926  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3927  char *s=SPrintEnd();
3928  int l=strlen(s)-1;
3929  s[l]='\0';
3930  res->data=(void*)s;
3931  return FALSE;
3932}
3933static BOOLEAN jjDEFINED(leftv res, leftv v)
3934{
3935  if ((v->rtyp==IDHDL)
3936  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3937  {
3938    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3939  }
3940  else if (v->rtyp!=0) res->data=(void *)(-1);
3941  return FALSE;
3942}
3943
3944/// Return the denominator of the input number
3945/// NOTE: the input number is normalized as a side effect
3946static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3947{
3948  number n = reinterpret_cast<number>(v->Data());
3949  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3950  return FALSE;
3951}
3952
3953/// Return the numerator of the input number
3954/// NOTE: the input number is normalized as a side effect
3955static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3956{
3957  number n = reinterpret_cast<number>(v->Data());
3958  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3959  return FALSE;
3960}
3961
3962static BOOLEAN jjDET(leftv res, leftv v)
3963{
3964  matrix m=(matrix)v->Data();
3965  poly p;
3966  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3967  {
3968    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3969    p=sm_CallDet(I, currRing);
3970    idDelete(&I);
3971  }
3972  else
3973    p=singclap_det(m,currRing);
3974  res ->data = (char *)p;
3975  return FALSE;
3976}
3977static BOOLEAN jjDET_BI(leftv res, leftv v)
3978{
3979  bigintmat * m=(bigintmat*)v->Data();
3980  int i,j;
3981  i=m->rows();j=m->cols();
3982  if(i==j)
3983    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3984  else
3985  {
3986    Werror("det of %d x %d bigintmat",i,j);
3987    return TRUE;
3988  }
3989  return FALSE;
3990}
3991static BOOLEAN jjDET_I(leftv res, leftv v)
3992{
3993  intvec * m=(intvec*)v->Data();
3994  int i,j;
3995  i=m->rows();j=m->cols();
3996  if(i==j)
3997    res->data = (char *)(long)singclap_det_i(m,currRing);
3998  else
3999  {
4000    Werror("det of %d x %d intmat",i,j);
4001    return TRUE;
4002  }
4003  return FALSE;
4004}
4005static BOOLEAN jjDET_S(leftv res, leftv v)
4006{
4007  ideal I=(ideal)v->Data();
4008  poly p;
4009  if (IDELEMS(I)<1) return TRUE;
4010  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
4011  {
4012    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
4013    p=singclap_det(m,currRing);
4014    idDelete((ideal *)&m);
4015  }
4016  else
4017    p=sm_CallDet(I, currRing);
4018  res->data = (char *)p;
4019  return FALSE;
4020}
4021static BOOLEAN jjDIM(leftv res, leftv v)
4022{
4023  assumeStdFlag(v);
4024#ifdef HAVE_RINGS
4025  if (rField_is_Ring(currRing))
4026  {
4027    //ring origR = currRing;
4028    //ring tempR = rCopy(origR);
4029    //coeffs new_cf=nInitChar(n_Q,NULL);
4030    //nKillChar(tempR->cf);
4031    //tempR->cf=new_cf;
4032    //rComplete(tempR);
4033    ideal vid = (ideal)v->Data();
4034    int i = idPosConstant(vid);
4035    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4036    { /* ideal v contains unit; dim = -1 */
4037      res->data = (char *)-1;
4038      return FALSE;
4039    }
4040    //rChangeCurrRing(tempR);
4041    //ideal vv = idrCopyR(vid, origR, currRing);
4042    ideal vv = id_Head(vid,currRing);
4043    /* drop degree zero generator from vv (if any) */
4044    if (i != -1) pDelete(&vv->m[i]);
4045    long d = (long)scDimInt(vv, currRing->qideal);
4046    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
4047    res->data = (char *)d;
4048    idDelete(&vv);
4049    //rChangeCurrRing(origR);
4050    //rDelete(tempR);
4051    return FALSE;
4052  }
4053#endif
4054  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4055  return FALSE;
4056}
4057static BOOLEAN jjDUMP(leftv, leftv v)
4058{
4059  si_link l = (si_link)v->Data();
4060  if (slDump(l))
4061  {
4062    const char *s;
4063    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4064    else                            s=sNoName;
4065    Werror("cannot dump to `%s`",s);
4066    return TRUE;
4067  }
4068  else
4069    return FALSE;
4070}
4071static BOOLEAN jjE(leftv res, leftv v)
4072{
4073  res->data = (char *)pOne();
4074  int co=(int)(long)v->Data();
4075  if (co>0)
4076  {
4077    pSetComp((poly)res->data,co);
4078    pSetm((poly)res->data);
4079  }
4080  else WerrorS("argument of gen must be positive");
4081  return (co<=0);
4082}
4083static BOOLEAN jjEXECUTE(leftv, leftv v)
4084{
4085  char * d = (char *)v->Data();
4086  char * s = (char *)omAlloc(strlen(d) + 13);
4087  strcpy( s, (char *)d);
4088  strcat( s, "\n;RETURN();\n");
4089  newBuffer(s,BT_execute);
4090  return yyparse();
4091}
4092static BOOLEAN jjFACSTD(leftv res, leftv v)
4093{
4094  lists L=(lists)omAllocBin(slists_bin);
4095  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4096  {
4097    ideal_list p,h;
4098    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4099    if (h==NULL)
4100    {
4101      L->Init(1);
4102      L->m[0].data=(char *)idInit(1);
4103      L->m[0].rtyp=IDEAL_CMD;
4104    }
4105    else
4106    {
4107      p=h;
4108      int l=0;
4109      while (p!=NULL) { p=p->next;l++; }
4110      L->Init(l);
4111      l=0;
4112      while(h!=NULL)
4113      {
4114        L->m[l].data=(char *)h->d;
4115        L->m[l].rtyp=IDEAL_CMD;
4116        p=h->next;
4117        omFreeSize(h,sizeof(*h));
4118        h=p;
4119        l++;
4120      }
4121    }
4122  }
4123  else
4124  {
4125    WarnS("no factorization implemented");
4126    L->Init(1);
4127    iiExprArith1(&(L->m[0]),v,STD_CMD);
4128  }
4129  res->data=(void *)L;
4130  return FALSE;
4131}
4132static BOOLEAN jjFAC_P(leftv res, leftv u)
4133{
4134  intvec *v=NULL;
4135  singclap_factorize_retry=0;
4136  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4137  if (f==NULL) return TRUE;
4138  ivTest(v);
4139  lists l=(lists)omAllocBin(slists_bin);
4140  l->Init(2);
4141  l->m[0].rtyp=IDEAL_CMD;
4142  l->m[0].data=(void *)f;
4143  l->m[1].rtyp=INTVEC_CMD;
4144  l->m[1].data=(void *)v;
4145  res->data=(void *)l;
4146  return FALSE;
4147}
4148static BOOLEAN jjGETDUMP(leftv, leftv v)
4149{
4150  si_link l = (si_link)v->Data();
4151  if (slGetDump(l))
4152  {
4153    const char *s;
4154    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4155    else                            s=sNoName;
4156    Werror("cannot get dump from `%s`",s);
4157    return TRUE;
4158  }
4159  else
4160    return FALSE;
4161}
4162static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4163{
4164  assumeStdFlag(v);
4165  ideal I=(ideal)v->Data();
4166  res->data=(void *)iiHighCorner(I,0);
4167  return FALSE;
4168}
4169static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4170{
4171  assumeStdFlag(v);
4172  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4173  BOOLEAN delete_w=FALSE;
4174  ideal I=(ideal)v->Data();
4175  int i;
4176  poly p=NULL,po=NULL;
4177  int rk=id_RankFreeModule(I,currRing);
4178  if (w==NULL)
4179  {
4180    w = new intvec(rk);
4181    delete_w=TRUE;
4182  }
4183  for(i=rk;i>0;i--)
4184  {
4185    p=iiHighCorner(I,i);
4186    if (p==NULL)
4187    {
4188      WerrorS("module must be zero-dimensional");
4189      if (delete_w) delete w;
4190      return TRUE;
4191    }
4192    if (po==NULL)
4193    {
4194      po=p;
4195    }
4196    else
4197    {
4198      // now po!=NULL, p!=NULL
4199      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4200      if (d==0)
4201        d=pLmCmp(po,p);
4202      if (d > 0)
4203      {
4204        pDelete(&p);
4205      }
4206      else // (d < 0)
4207      {
4208        pDelete(&po); po=p;
4209      }
4210    }
4211  }
4212  if (delete_w) delete w;
4213  res->data=(void *)po;
4214  return FALSE;
4215}
4216static BOOLEAN jjHILBERT(leftv, leftv v)
4217{
4218#ifdef HAVE_RINGS
4219  if (rField_is_Ring_Z(currRing))
4220  {
4221    ring origR = currRing;
4222    ring tempR = rCopy(origR);
4223    coeffs new_cf=nInitChar(n_Q,NULL);
4224    nKillChar(tempR->cf);
4225    tempR->cf=new_cf;
4226    rComplete(tempR);
4227    ideal vid = (ideal)v->Data();
4228    rChangeCurrRing(tempR);
4229    ideal vv = idrCopyR(vid, origR, currRing);
4230    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4231    vvAsLeftv.rtyp = IDEAL_CMD;
4232    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4233    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4234    assumeStdFlag(&vvAsLeftv);
4235    Print("// NOTE: computation of Hilbert series etc. is being\n");
4236    Print("//       performed for generic fibre, that is, over Q\n");
4237    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4238    //scHilbertPoly(vv,currRing->qideal);
4239    hLookSeries(vv,module_w,currRing->qideal);
4240    idDelete(&vv);
4241    rChangeCurrRing(origR);
4242    rDelete(tempR);
4243    return FALSE;
4244  }
4245#endif
4246  assumeStdFlag(v);
4247  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4248  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4249  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4250  return FALSE;
4251}
4252static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4253{
4254#ifdef HAVE_RINGS
4255  if (rField_is_Ring_Z(currRing))
4256  {
4257    Print("// NOTE: computation of Hilbert series etc. is being\n");
4258    Print("//       performed for generic fibre, that is, over Q\n");
4259  }
4260#endif
4261  res->data=(void *)hSecondSeries((intvec *)v->Data());
4262  return FALSE;
4263}
4264static BOOLEAN jjHOMOG1(leftv res, leftv v)
4265{
4266  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4267  ideal v_id=(ideal)v->Data();
4268  if (w==NULL)
4269  {
4270    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4271    if (res->data!=NULL)
4272    {
4273      if (v->rtyp==IDHDL)
4274      {
4275        char *s_isHomog=omStrDup("isHomog");
4276        if (v->e==NULL)
4277          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4278        else
4279          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4280      }
4281      else if (w!=NULL) delete w;
4282    } // if res->data==NULL then w==NULL
4283  }
4284  else
4285  {
4286    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4287    if((res->data==NULL) && (v->rtyp==IDHDL))
4288    {
4289      if (v->e==NULL)
4290        atKill((idhdl)(v->data),"isHomog");
4291      else
4292        atKill((idhdl)(v->LData()),"isHomog");
4293    }
4294  }
4295  return FALSE;
4296}
4297static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4298{
4299  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4300  setFlag(res,FLAG_STD);
4301  return FALSE;
4302}
4303static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4304{
4305  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4306  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4307  if (IDELEMS((ideal)mat)==0)
4308  {
4309    idDelete((ideal *)&mat);
4310    mat=(matrix)idInit(1,1);
4311  }
4312  else
4313  {
4314    MATROWS(mat)=1;
4315    mat->rank=1;
4316    idTest((ideal)mat);
4317  }
4318  res->data=(char *)mat;
4319  return FALSE;
4320}
4321static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4322{
4323  map m=(map)v->CopyD(MAP_CMD);
4324  omFree((ADDRESS)m->preimage);
4325  m->preimage=NULL;
4326  ideal I=(ideal)m;
4327  I->rank=1;
4328  res->data=(char *)I;
4329  return FALSE;
4330}
4331static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4332{
4333  if (currRing!=NULL)
4334  {
4335    ring q=(ring)v->Data();
4336    if (rSamePolyRep(currRing, q))
4337    {
4338      if (q->qideal==NULL)
4339        res->data=(char *)idInit(1,1);
4340      else
4341        res->data=(char *)idCopy(q->qideal);
4342      return FALSE;
4343    }
4344  }
4345  WerrorS("can only get ideal from identical qring");
4346  return TRUE;
4347}
4348static BOOLEAN jjIm2Iv(leftv res, leftv v)
4349{
4350  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4351  iv->makeVector();
4352  res->data = iv;
4353  return FALSE;
4354}
4355static BOOLEAN jjIMPART(leftv res, leftv v)
4356{
4357  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4358  return FALSE;
4359}
4360static BOOLEAN jjINDEPSET(leftv res, leftv v)
4361{
4362  assumeStdFlag(v);
4363  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4364  return FALSE;
4365}
4366static BOOLEAN jjINTERRED(leftv res, leftv v)
4367{
4368  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4369  #ifdef HAVE_RINGS
4370  if(rField_is_Ring(currRing))
4371    Warn("interred: this command is experimental over the integers");
4372  #endif
4373  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4374  res->data = result;
4375  return FALSE;
4376}
4377static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4378{
4379  res->data = (char *)(long)pVar((poly)v->Data());
4380  return FALSE;
4381}
4382static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4383{
4384  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4385                                                            currRing->N)+1);
4386  return FALSE;
4387}
4388static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4389{
4390  res->data = (char *)0;
4391  return FALSE;
4392}
4393static BOOLEAN jjJACOB_P(leftv res, leftv v)
4394{
4395  ideal i=idInit(currRing->N,1);
4396  int k;
4397  poly p=(poly)(v->Data());
4398  for (k=currRing->N;k>0;k--)
4399  {
4400    i->m[k-1]=pDiff(p,k);
4401  }
4402  res->data = (char *)i;
4403  return FALSE;
4404}
4405static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4406{
4407  if (!nCoeff_is_transExt(currRing->cf))
4408  {
4409    WerrorS("differentiation not defined in the coefficient ring");
4410    return TRUE;
4411  }
4412  number n = (number) u->Data();
4413  number k = (number) v->Data();
4414  res->data = ntDiff(n,k,currRing->cf);
4415  return FALSE;
4416}
4417/*2
4418 * compute Jacobi matrix of a module/matrix
4419 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4420 * where Mt := transpose(M)
4421 * Note that this is consistent with the current conventions for jacob in Singular,
4422 * whereas M2 computes its transposed.
4423 */
4424static BOOLEAN jjJACOB_M(leftv res, leftv a)
4425{
4426  ideal id = (ideal)a->Data();
4427  id = idTransp(id);
4428  int W = IDELEMS(id);
4429
4430  ideal result = idInit(W * currRing->N, id->rank);
4431  poly *p = result->m;
4432
4433  for( int v = 1; v <= currRing->N; v++ )
4434  {
4435    poly* q = id->m;
4436    for( int i = 0; i < W; i++, p++, q++ )
4437      *p = pDiff( *q, v );
4438  }
4439  idDelete(&id);
4440
4441  res->data = (char *)result;
4442  return FALSE;
4443}
4444
4445
4446static BOOLEAN jjKBASE(leftv res, leftv v)
4447{
4448  assumeStdFlag(v);
4449  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4450  return FALSE;
4451}
4452static BOOLEAN jjL2R(leftv res, leftv v)
4453{
4454  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4455  if (res->data != NULL)
4456    return FALSE;
4457  else
4458    return TRUE;
4459}
4460static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4461{
4462  poly p=(poly)v->Data();
4463  if (p==NULL)
4464  {
4465    res->data=(char *)nInit(0);
4466  }
4467  else
4468  {
4469    res->data=(char *)nCopy(pGetCoeff(p));
4470  }
4471  return FALSE;
4472}
4473static BOOLEAN jjLEADEXP(leftv res, leftv v)
4474{
4475  poly p=(poly)v->Data();
4476  int s=currRing->N;
4477  if (v->Typ()==VECTOR_CMD) s++;
4478  intvec *iv=new intvec(s);
4479  if (p!=NULL)
4480  {
4481    for(int i = currRing->N;i;i--)
4482    {
4483      (*iv)[i-1]=pGetExp(p,i);
4484    }
4485    if (s!=currRing->N)
4486      (*iv)[currRing->N]=pGetComp(p);
4487  }
4488  res->data=(char *)iv;
4489  return FALSE;
4490}
4491static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4492{
4493  poly p=(poly)v->Data();
4494  if (p == NULL)
4495  {
4496    res->data = (char*) NULL;
4497  }
4498  else
4499  {
4500    poly lm = pLmInit(p);
4501    pSetCoeff(lm, nInit(1));
4502    res->data = (char*) lm;
4503  }
4504  return FALSE;
4505}
4506static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4507{
4508  return jjLOAD((char*)v->Data(),FALSE);
4509}
4510static BOOLEAN jjLISTRING(leftv res, leftv v)
4511{
4512  ring r=rCompose((lists)v->Data());
4513  if (r==NULL) return TRUE;
4514  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4515  res->data=(char *)r;
4516  return FALSE;
4517}
4518static BOOLEAN jjPFAC1(leftv res, leftv v)
4519{
4520  /* call method jjPFAC2 with second argument = 0 (meaning that no
4521     valid bound for the prime factors has been given) */
4522  sleftv tmp;
4523  memset(&tmp, 0, sizeof(tmp));
4524  tmp.rtyp = INT_CMD;
4525  return jjPFAC2(res, v, &tmp);
4526}
4527static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4528{
4529  /* computes the LU-decomposition of a matrix M;
4530     i.e., M = P * L * U, where
4531        - P is a row permutation matrix,
4532        - L is in lower triangular form,
4533        - U is in upper row echelon form
4534     Then, we also have P * M = L * U.
4535     A list [P, L, U] is returned. */
4536  matrix mat = (const matrix)v->Data();
4537  if (!idIsConstant((ideal)mat))
4538  {
4539    WerrorS("matrix must be constant");
4540    return TRUE;
4541  }
4542  matrix pMat;
4543  matrix lMat;
4544  matrix uMat;
4545
4546  luDecomp(mat, pMat, lMat, uMat);
4547
4548  lists ll = (lists)omAllocBin(slists_bin);
4549  ll->Init(3);
4550  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4551  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4552  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4553  res->data=(char*)ll;
4554
4555  return FALSE;
4556}
4557static BOOLEAN jjMEMORY(leftv res, leftv v)
4558{
4559  omUpdateInfo();
4560  switch(((int)(long)v->Data()))
4561  {
4562  case 0:
4563    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4564    break;
4565  case 1:
4566    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4567    break;
4568  case 2:
4569    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4570    break;
4571  default:
4572    omPrintStats(stdout);
4573    omPrintInfo(stdout);
4574    omPrintBinStats(stdout);
4575    res->data = (char *)0;
4576    res->rtyp = NONE;
4577  }
4578  return FALSE;
4579  res->data = (char *)0;
4580  return FALSE;
4581}
4582//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4583//{
4584//  return jjMONITOR2(res,v,NULL);
4585//}
4586static BOOLEAN jjMSTD(leftv res, leftv v)
4587{
4588  int t=v->Typ();
4589  ideal r,m;
4590  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4591  lists l=(lists)omAllocBin(slists_bin);
4592  l->Init(2);
4593  l->m[0].rtyp=t;
4594  l->m[0].data=(char *)r;
4595  setFlag(&(l->m[0]),FLAG_STD);
4596  l->m[1].rtyp=t;
4597  l->m[1].data=(char *)m;
4598  res->data=(char *)l;
4599  return FALSE;
4600}
4601static BOOLEAN jjMULT(leftv res, leftv v)
4602{
4603  assumeStdFlag(v);
4604  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4605  return FALSE;
4606}
4607static BOOLEAN jjMINRES_R(leftv res, leftv v)
4608{
4609  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4610
4611  syStrategy tmp=(syStrategy)v->Data();
4612  tmp = syMinimize(tmp); // enrich itself!
4613
4614  res->data=(char *)tmp;
4615
4616  if (weights!=NULL)
4617    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4618
4619  return FALSE;
4620}
4621static BOOLEAN jjN2BI(leftv res, leftv v)
4622{
4623  number n,i; i=(number)v->Data();
4624  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4625  if (nMap!=NULL)
4626    n=nMap(i,currRing->cf,coeffs_BIGINT);
4627  else goto err;
4628  res->data=(void *)n;
4629  return FALSE;
4630err:
4631  WerrorS("cannot convert to bigint"); return TRUE;
4632}
4633static BOOLEAN jjNAMEOF(leftv res, leftv v)
4634{
4635  res->data = (char *)v->name;
4636  if (res->data==NULL) res->data=omStrDup("");
4637  v->name=NULL;
4638  return FALSE;
4639}
4640static BOOLEAN jjNAMES(leftv res, leftv v)
4641{
4642  res->data=ipNameList(((ring)v->Data())->idroot);
4643  return FALSE;
4644}
4645static BOOLEAN jjNAMES_I(leftv res, leftv v)
4646{
4647  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4648  return FALSE;
4649}
4650static BOOLEAN jjNOT(leftv res, leftv v)
4651{
4652  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4653  return FALSE;
4654}
4655static BOOLEAN jjNVARS(leftv res, leftv v)
4656{
4657  res->data = (char *)(long)(((ring)(v->Data()))->N);
4658  return FALSE;
4659}
4660static BOOLEAN jjOpenClose(leftv, leftv v)
4661{
4662  si_link l=(si_link)v->Data();
4663  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4664  else                return slClose(l);
4665}
4666static BOOLEAN jjORD(leftv res, leftv v)
4667{
4668  poly p=(poly)v->Data();
4669  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4670  return FALSE;
4671}
4672static BOOLEAN jjPAR1(leftv res, leftv v)
4673{
4674  int i=(int)(long)v->Data();
4675  int p=0;
4676  p=rPar(currRing);
4677  if ((0<i) && (i<=p))
4678  {
4679    res->data=(char *)n_Param(i,currRing);
4680  }
4681  else
4682  {
4683    Werror("par number %d out of range 1..%d",i,p);
4684    return TRUE;
4685  }
4686  return FALSE;
4687}
4688static BOOLEAN jjPARDEG(leftv res, leftv v)
4689{
4690  number nn=(number)v->Data();
4691  res->data = (char *)(long)n_ParDeg(nn, currRing);
4692  return FALSE;
4693}
4694static BOOLEAN jjPARSTR1(leftv res, leftv v)
4695{
4696  if (currRing==NULL)
4697  {
4698    WerrorS("no ring active");
4699    return TRUE;
4700  }
4701  int i=(int)(long)v->Data();
4702  int p=0;
4703  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4704    res->data=omStrDup(rParameter(currRing)[i-1]);
4705  else
4706  {
4707    Werror("par number %d out of range 1..%d",i,p);
4708    return TRUE;
4709  }
4710  return FALSE;
4711}
4712static BOOLEAN jjP2BI(leftv res, leftv v)
4713{
4714  poly p=(poly)v->Data();
4715  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4716  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4717  {
4718    WerrorS("poly must be constant");
4719    return TRUE;
4720  }
4721  number i=pGetCoeff(p);
4722  number n;
4723  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4724  if (nMap!=NULL)
4725    n=nMap(i,currRing->cf,coeffs_BIGINT);
4726  else goto err;
4727  res->data=(void *)n;
4728  return FALSE;
4729err:
4730  WerrorS("cannot convert to bigint"); return TRUE;
4731}
4732static BOOLEAN jjP2I(leftv res, leftv v)
4733{
4734  poly p=(poly)v->Data();
4735  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4736  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4737  {
4738    WerrorS("poly must be constant");
4739    return TRUE;
4740  }
4741  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4742  return FALSE;
4743}
4744static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4745{
4746  map mapping=(map)v->Data();
4747  syMake(res,omStrDup(mapping->preimage));
4748  return FALSE;
4749}
4750static BOOLEAN jjPRIME(leftv res, leftv v)
4751{
4752  int i = IsPrime((int)(long)(v->Data()));
4753  res->data = (char *)(long)(i > 1 ? i : 2);
4754  return FALSE;
4755}
4756static BOOLEAN jjPRUNE(leftv res, leftv v)
4757{
4758  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4759  ideal v_id=(ideal)v->Data();
4760  if (w!=NULL)
4761  {
4762    if (!idTestHomModule(v_id,currRing->qideal,w))
4763    {
4764      WarnS("wrong weights");
4765      w=NULL;
4766      // and continue at the non-homog case below
4767    }
4768    else
4769    {
4770      w=ivCopy(w);
4771      intvec **ww=&w;
4772      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4773      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4774      return FALSE;
4775    }
4776  }
4777  res->data = (char *)idMinEmbedding(v_id);
4778  return FALSE;
4779}
4780static BOOLEAN jjP2N(leftv res, leftv v)
4781{
4782  number n;
4783  poly p;
4784  if (((p=(poly)v->Data())!=NULL)
4785  && (pIsConstant(p)))
4786  {
4787    n=nCopy(pGetCoeff(p));
4788  }
4789  else
4790  {
4791    n=nInit(0);
4792  }
4793  res->data = (char *)n;
4794  return FALSE;
4795}
4796static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4797{
4798  char *s= (char *)v->Data();
4799  int i = 1;
4800  for(i=0; i<sArithBase.nCmdUsed; i++)
4801  {
4802    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4803    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4804    {
4805      res->data = (char *)1;
4806      return FALSE;
4807    }
4808  }
4809  //res->data = (char *)0;
4810  return FALSE;
4811}
4812static BOOLEAN jjRANK1(leftv res, leftv v)
4813{
4814  matrix m =(matrix)v->Data();
4815  int rank = luRank(m, 0);
4816  res->data =(char *)(long)rank;
4817  return FALSE;
4818}
4819static BOOLEAN jjREAD(leftv res, leftv v)
4820{
4821  return jjREAD2(res,v,NULL);
4822}
4823static BOOLEAN jjREGULARITY(leftv res, leftv v)
4824{
4825  res->data = (char *)(long)iiRegularity((lists)v->Data());
4826  return FALSE;
4827}
4828static BOOLEAN jjREPART(leftv res, leftv v)
4829{
4830  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4831  return FALSE;
4832}
4833static BOOLEAN jjRINGLIST(leftv res, leftv v)
4834{
4835  ring r=(ring)v->Data();
4836  if (r!=NULL)
4837    res->data = (char *)rDecompose((ring)v->Data());
4838  return (r==NULL)||(res->data==NULL);
4839}
4840static BOOLEAN jjROWS(leftv res, leftv v)
4841{
4842  ideal i = (ideal)v->Data();
4843  res->data = (char *)i->rank;
4844  return FALSE;
4845}
4846static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4847{
4848  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4849  return FALSE;
4850}
4851static BOOLEAN jjROWS_IV(leftv res, leftv v)
4852{
4853  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4854  return FALSE;
4855}
4856static BOOLEAN jjRPAR(leftv res, leftv v)
4857{
4858  res->data = (char *)(long)rPar(((ring)v->Data()));
4859  return FALSE;
4860}
4861static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4862{
4863#ifdef HAVE_PLURAL
4864  const bool bIsSCA = rIsSCA(currRing);
4865#else
4866  const bool bIsSCA = false;
4867#endif
4868
4869  if ((currRing->qideal!=NULL) && !bIsSCA)
4870  {
4871    WerrorS("qring not supported by slimgb at the moment");
4872    return TRUE;
4873  }
4874  if (rHasLocalOrMixedOrdering_currRing())
4875  {
4876    WerrorS("ordering must be global for slimgb");
4877    return TRUE;
4878  }
4879  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4880  // tHomog hom=testHomog;
4881  ideal u_id=(ideal)u->Data();
4882  if (w!=NULL)
4883  {
4884    if (!idTestHomModule(u_id,currRing->qideal,w))
4885    {
4886      WarnS("wrong weights");
4887      w=NULL;
4888    }
4889    else
4890    {
4891      w=ivCopy(w);
4892      // hom=isHomog;
4893    }
4894  }
4895
4896  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4897  res->data=(char *)t_rep_gb(currRing,
4898    u_id,u_id->rank);
4899  //res->data=(char *)t_rep_gb(currRing, u_id);
4900
4901  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4902  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4903  return FALSE;
4904}
4905static BOOLEAN jjSBA(leftv res, leftv v)
4906{
4907  ideal result;
4908  ideal v_id=(ideal)v->Data();
4909  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4910  tHomog hom=testHomog;
4911  if (w!=NULL)
4912  {
4913    if (!idTestHomModule(v_id,currRing->qideal,w))
4914    {
4915      WarnS("wrong weights");
4916      w=NULL;
4917    }
4918    else
4919    {
4920      hom=isHomog;
4921      w=ivCopy(w);
4922    }
4923  }
4924  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4925  idSkipZeroes(result);
4926  res->data = (char *)result;
4927  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4928  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4929  return FALSE;
4930}
4931static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4932{
4933  ideal result;
4934  ideal v_id=(ideal)v->Data();
4935  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4936  tHomog hom=testHomog;
4937  if (w!=NULL)
4938  {
4939    if (!idTestHomModule(v_id,currRing->qideal,w))
4940    {
4941      WarnS("wrong weights");
4942      w=NULL;
4943    }
4944    else
4945    {
4946      hom=isHomog;
4947      w=ivCopy(w);
4948    }
4949  }
4950  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4951  idSkipZeroes(result);
4952  res->data = (char *)result;
4953  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4954  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4955  return FALSE;
4956}
4957static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4958{
4959  ideal result;
4960  ideal v_id=(ideal)v->Data();
4961  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4962  tHomog hom=testHomog;
4963  if (w!=NULL)
4964  {
4965    if (!idTestHomModule(v_id,currRing->qideal,w))
4966    {
4967      WarnS("wrong weights");
4968      w=NULL;
4969    }
4970    else
4971    {
4972      hom=isHomog;
4973      w=ivCopy(w);
4974    }
4975  }
4976  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4977  idSkipZeroes(result);
4978  res->data = (char *)result;
4979  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4980  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4981  return FALSE;
4982}
4983static BOOLEAN jjSTD(leftv res, leftv v)
4984{
4985  ideal result;
4986  ideal v_id=(ideal)v->Data();
4987  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4988  tHomog hom=testHomog;
4989  if (w!=NULL)
4990  {
4991    if (!idTestHomModule(v_id,currRing->qideal,w))
4992    {
4993      WarnS("wrong weights");
4994      w=NULL;
4995    }
4996    else
4997    {
4998      hom=isHomog;
4999      w=ivCopy(w);
5000    }
5001  }
5002  result=kStd(v_id,currRing->qideal,hom,&w);
5003  idSkipZeroes(result);
5004  res->data = (char *)result;
5005  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5006  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5007  return FALSE;
5008}
5009static BOOLEAN jjSort_Id(leftv res, leftv v)
5010{
5011  res->data = (char *)idSort((ideal)v->Data());
5012  return FALSE;
5013}
5014static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5015{
5016  singclap_factorize_retry=0;
5017  intvec *v=NULL;
5018  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5019  if (f==NULL) return TRUE;
5020  ivTest(v);
5021  lists l=(lists)omAllocBin(slists_bin);
5022  l->Init(2);
5023  l->m[0].rtyp=IDEAL_CMD;
5024  l->m[0].data=(void *)f;
5025  l->m[1].rtyp=INTVEC_CMD;
5026  l->m[1].data=(void *)v;
5027  res->data=(void *)l;
5028  return FALSE;
5029}
5030#if 1
5031static BOOLEAN jjSYZYGY(leftv res, leftv v)
5032{
5033  intvec *w=NULL;
5034  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5035  if (w!=NULL) delete w;
5036  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5037  return FALSE;
5038}
5039#else
5040// activate, if idSyz handle module weights correctly !
5041static BOOLEAN jjSYZYGY(leftv res, leftv v)
5042{
5043  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5044  ideal v_id=(ideal)v->Data();
5045  tHomog hom=testHomog;
5046  int add_row_shift=0;
5047  if (w!=NULL)
5048  {
5049    w=ivCopy(w);
5050    add_row_shift=w->min_in();
5051    (*w)-=add_row_shift;
5052    if (idTestHomModule(v_id,currRing->qideal,w))
5053      hom=isHomog;
5054    else
5055    {
5056      //WarnS("wrong weights");
5057      delete w; w=NULL;
5058      hom=testHomog;
5059    }
5060  }
5061  res->data = (char *)idSyzygies(v_id,hom,&w);
5062  if (w!=NULL)
5063  {
5064    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5065  }
5066  return FALSE;
5067}
5068#endif
5069static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5070{
5071  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5072  return FALSE;
5073}
5074static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5075{
5076  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5077  return FALSE;
5078}
5079static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5080{
5081  res->data = (char *)ivTranp((intvec*)(v->Data()));
5082  return FALSE;
5083}
5084#ifdef HAVE_PLURAL
5085static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5086{
5087  ring    r = (ring)a->Data();
5088  //if (rIsPluralRing(r))
5089  if (r->OrdSgn==1)
5090  {
5091    res->data = rOpposite(r);
5092  }
5093  else
5094  {
5095    WarnS("opposite only for global orderings");
5096    res->data = rCopy(r);
5097  }
5098  return FALSE;
5099}
5100static BOOLEAN jjENVELOPE(leftv res, leftv a)
5101{
5102  ring    r = (ring)a->Data();
5103  if (rIsPluralRing(r))
5104  {
5105    //    ideal   i;
5106//     if (a->rtyp == QRING_CMD)
5107//     {
5108//       i = r->qideal;
5109//       r->qideal = NULL;
5110//     }
5111    ring s = rEnvelope(r);
5112//     if (a->rtyp == QRING_CMD)
5113//     {
5114//       ideal is  = idOppose(r,i); /* twostd? */
5115//       is        = idAdd(is,i);
5116//       s->qideal = i;
5117//     }
5118    res->data = s;
5119  }
5120  else  res->data = rCopy(r);
5121  return FALSE;
5122}
5123static BOOLEAN jjTWOSTD(leftv res, leftv a)
5124{
5125  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5126  else  res->data=(ideal)a->CopyD();
5127  setFlag(res,FLAG_STD);
5128  setFlag(res,FLAG_TWOSTD);
5129  return FALSE;
5130}
5131#endif
5132
5133static BOOLEAN jjTYPEOF(leftv res, leftv v)
5134{
5135  int t=(int)(long)v->data;
5136  switch (t)
5137  {
5138    case CRING_CMD:
5139    case INT_CMD:
5140    case POLY_CMD:
5141    case VECTOR_CMD:
5142    case STRING_CMD:
5143    case INTVEC_CMD:
5144    case IDEAL_CMD:
5145    case MATRIX_CMD:
5146    case MODUL_CMD:
5147    case MAP_CMD:
5148    case PROC_CMD:
5149    case RING_CMD:
5150    case QRING_CMD:
5151    case INTMAT_CMD:
5152    case BIGINTMAT_CMD:
5153    case NUMBER_CMD:
5154    #ifdef SINGULAR_4_1
5155    case CNUMBER_CMD:
5156    #endif
5157    case BIGINT_CMD:
5158    case LIST_CMD:
5159    case PACKAGE_CMD:
5160    case LINK_CMD:
5161    case RESOLUTION_CMD:
5162         res->data=omStrDup(Tok2Cmdname(t)); break;
5163    case DEF_CMD:
5164    case NONE:           res->data=omStrDup("none"); break;
5165    default:
5166    {
5167      if (t>MAX_TOK)
5168        res->data=omStrDup(getBlackboxName(t));
5169      else
5170        res->data=omStrDup("?unknown type?");
5171      break;
5172    }
5173  }
5174  return FALSE;
5175}
5176static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5177{
5178  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5179  return FALSE;
5180}
5181static BOOLEAN jjVAR1(leftv res, leftv v)
5182{
5183  int i=(int)(long)v->Data();
5184  if ((0<i) && (i<=currRing->N))
5185  {
5186    poly p=pOne();
5187    pSetExp(p,i,1);
5188    pSetm(p);
5189    res->data=(char *)p;
5190  }
5191  else
5192  {
5193    Werror("var number %d out of range 1..%d",i,currRing->N);
5194    return TRUE;
5195  }
5196  return FALSE;
5197}
5198static BOOLEAN jjVARSTR1(leftv res, leftv v)
5199{
5200  if (currRing==NULL)
5201  {
5202    WerrorS("no ring active");
5203    return TRUE;
5204  }
5205  int i=(int)(long)v->Data();
5206  if ((0<i) && (i<=currRing->N))
5207    res->data=omStrDup(currRing->names[i-1]);
5208  else
5209  {
5210    Werror("var number %d out of range 1..%d",i,currRing->N);
5211    return TRUE;
5212  }
5213  return FALSE;
5214}
5215static BOOLEAN jjVDIM(leftv res, leftv v)
5216{
5217  assumeStdFlag(v);
5218  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5219  return FALSE;
5220}
5221BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5222{
5223// input: u: a list with links of type
5224//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5225// returns: -1:  the read state of all links is eof
5226//          i>0: (at least) u[i] is ready
5227  lists Lforks = (lists)u->Data();
5228  int i = slStatusSsiL(Lforks, -1);
5229  if(i == -2) /* error */
5230  {
5231    return TRUE;
5232  }
5233  res->data = (void*)(long)i;
5234  return FALSE;
5235}
5236BOOLEAN jjWAITALL1(leftv res, leftv u)
5237{
5238// input: u: a list with links of type
5239//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5240// returns: -1: the read state of all links is eof
5241//           1: all links are ready
5242//              (caution: at least one is ready, but some maybe dead)
5243  lists Lforks = (lists)u->CopyD();
5244  int i;
5245  int j = -1;
5246  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5247  {
5248    i = slStatusSsiL(Lforks, -1);
5249    if(i == -2) /* error */
5250    {
5251      return TRUE;
5252    }
5253    if(i == -1)
5254    {
5255      break;
5256    }
5257    j = 1;
5258    Lforks->m[i-1].CleanUp();
5259    Lforks->m[i-1].rtyp=DEF_CMD;
5260    Lforks->m[i-1].data=NULL;
5261  }
5262  res->data = (void*)(long)j;
5263  Lforks->Clean();
5264  return FALSE;
5265}
5266
5267BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5268{
5269  char libnamebuf[256];
5270  lib_types LT = type_of_LIB(s, libnamebuf);
5271
5272#ifdef HAVE_DYNAMIC_LOADING
5273  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5274#endif /* HAVE_DYNAMIC_LOADING */
5275  switch(LT)
5276  {
5277      default:
5278      case LT_NONE:
5279        Werror("%s: unknown type", s);
5280        break;
5281      case LT_NOTFOUND:
5282        Werror("cannot open %s", s);
5283        break;
5284
5285      case LT_SINGULAR:
5286      {
5287        char *plib = iiConvName(s);
5288        idhdl pl = IDROOT->get(plib,0);
5289        if (pl==NULL)
5290        {
5291          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5292          IDPACKAGE(pl)->language = LANG_SINGULAR;
5293          IDPACKAGE(pl)->libname=omStrDup(plib);
5294        }
5295        else if (IDTYP(pl)!=PACKAGE_CMD)
5296        {
5297          Werror("can not create package `%s`",plib);
5298          omFree(plib);
5299          return TRUE;
5300        }
5301        package savepack=currPack;
5302        currPack=IDPACKAGE(pl);
5303        IDPACKAGE(pl)->loaded=TRUE;
5304        char libnamebuf[256];
5305        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5306        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5307        currPack=savepack;
5308        IDPACKAGE(pl)->loaded=(!bo);
5309        return bo;
5310      }
5311      case LT_BUILTIN:
5312        SModulFunc_t iiGetBuiltinModInit(const char*);
5313        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5314      case LT_MACH_O:
5315      case LT_ELF:
5316      case LT_HPUX:
5317#ifdef HAVE_DYNAMIC_LOADING
5318        return load_modules(s, libnamebuf, autoexport);
5319#else /* HAVE_DYNAMIC_LOADING */
5320        WerrorS("Dynamic modules are not supported by this version of Singular");
5321        break;
5322#endif /* HAVE_DYNAMIC_LOADING */
5323  }
5324  return TRUE;
5325}
5326static int WerrorS_dummy_cnt=0;
5327static void WerrorS_dummy(const char *)
5328{
5329  WerrorS_dummy_cnt++;
5330}
5331BOOLEAN jjLOAD_TRY(const char *s)
5332{
5333  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5334  WerrorS_callback=WerrorS_dummy;
5335  WerrorS_dummy_cnt=0;
5336  BOOLEAN bo=jjLOAD(s,TRUE);
5337  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5338    Print("loading of >%s< failed\n",s);
5339  WerrorS_callback=WerrorS_save;
5340  errorreported=0;
5341  return FALSE;
5342}
5343
5344static BOOLEAN jjstrlen(leftv res, leftv v)
5345{
5346  res->data = (char *)strlen((char *)v->Data());
5347  return FALSE;
5348}
5349static BOOLEAN jjpLength(leftv res, leftv v)
5350{
5351  res->data = (char *)(long)pLength((poly)v->Data());
5352  return FALSE;
5353}
5354static BOOLEAN jjidElem(leftv res, leftv v)
5355{
5356  res->data = (char *)(long)idElem((ideal)v->Data());
5357  return FALSE;
5358}
5359static BOOLEAN jjidFreeModule(leftv res, leftv v)
5360{
5361  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5362  return FALSE;
5363}
5364static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5365{
5366  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5367  return FALSE;
5368}
5369static BOOLEAN jjrCharStr(leftv res, leftv v)
5370{
5371#ifdef SINGULAR_4_1
5372  iiReWrite("charstr");
5373#endif
5374  res->data = rCharStr((ring)v->Data());
5375  return FALSE;
5376}
5377static BOOLEAN jjpHead(leftv res, leftv v)
5378{
5379  res->data = (char *)pHead((poly)v->Data());
5380  return FALSE;
5381}
5382static BOOLEAN jjidHead(leftv res, leftv v)
5383{
5384  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5385  setFlag(res,FLAG_STD);
5386  return FALSE;
5387}
5388static BOOLEAN jjidMinBase(leftv res, leftv v)
5389{
5390  res->data = (char *)idMinBase((ideal)v->Data());
5391  return FALSE;
5392}
5393static BOOLEAN jjsyMinBase(leftv res, leftv v)
5394{
5395  res->data = (char *)syMinBase((ideal)v->Data());
5396  return FALSE;
5397}
5398static BOOLEAN jjpMaxComp(leftv res, leftv v)
5399{
5400  res->data = (char *)pMaxComp((poly)v->Data());
5401  return FALSE;
5402}
5403static BOOLEAN jjmpTrace(leftv res, leftv v)
5404{
5405  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5406  return FALSE;
5407}
5408static BOOLEAN jjmpTransp(leftv res, leftv v)
5409{
5410  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5411  return FALSE;
5412}
5413static BOOLEAN jjrOrdStr(leftv res, leftv v)
5414{
5415#ifdef SINGULAR_4_1
5416  iiReWrite("ordstr");
5417#endif
5418  res->data = rOrdStr((ring)v->Data());
5419  return FALSE;
5420}
5421static BOOLEAN jjrVarStr(leftv res, leftv v)
5422{
5423#ifdef SINGULAR_4_1
5424  iiReWrite("varstr");
5425#endif
5426  res->data = rVarStr((ring)v->Data());
5427  return FALSE;
5428}
5429static BOOLEAN jjrParStr(leftv res, leftv v)
5430{
5431#ifdef SINGULAR_4_1
5432  iiReWrite("varstr");
5433#endif
5434  res->data = rParStr((ring)v->Data());
5435  return FALSE;
5436}
5437static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5438{
5439  res->data=(char *)(long)sySize((syStrategy)v->Data());
5440  return FALSE;
5441}
5442static BOOLEAN jjDIM_R(leftv res, leftv v)
5443{
5444  res->data = (char *)(long)syDim((syStrategy)v->Data());
5445  return FALSE;
5446}
5447static BOOLEAN jjidTransp(leftv res, leftv v)
5448{
5449  res->data = (char *)idTransp((ideal)v->Data());
5450  return FALSE;
5451}
5452static BOOLEAN jjnInt(leftv res, leftv u)
5453{
5454  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5455  res->data=(char *)(long)iin_Int(n,currRing->cf);
5456  n_Delete(&n,currRing->cf);
5457  return FALSE;
5458}
5459static BOOLEAN jjnlInt(leftv res, leftv u)
5460{
5461  number n=(number)u->Data();
5462  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5463  return FALSE;
5464}
5465/*=================== operations with 3 args.: static proc =================*/
5466/* must be ordered: first operations for chars (infix ops),
5467 * then alphabetically */
5468static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5469{
5470  char *s= (char *)u->Data();
5471  int   r = (int)(long)v->Data();
5472  int   c = (int)(long)w->Data();
5473  int l = strlen(s);
5474
5475  if ( (r<1) || (r>l) || (c<0) )
5476  {
5477    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5478    return TRUE;
5479  }
5480  res->data = (char *)omAlloc((long)(c+1));
5481  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5482  return FALSE;
5483}
5484static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5485{
5486  intvec *iv = (intvec *)u->Data();
5487  int   r = (int)(long)v->Data();
5488  int   c = (int)(long)w->Data();
5489  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5490  {
5491    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5492           r,c,u->Fullname(),iv->rows(),iv->cols());
5493    return TRUE;
5494  }
5495  res->data=u->data; u->data=NULL;
5496  res->rtyp=u->rtyp; u->rtyp=0;
5497  res->name=u->name; u->name=NULL;
5498  Subexpr e=jjMakeSub(v);
5499          e->next=jjMakeSub(w);
5500  if (u->e==NULL) res->e=e;
5501  else
5502  {
5503    Subexpr h=u->e;
5504    while (h->next!=NULL) h=h->next;
5505    h->next=e;
5506    res->e=u->e;
5507    u->e=NULL;
5508  }
5509  return FALSE;
5510}
5511static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5512{
5513  bigintmat *bim = (bigintmat *)u->Data();
5514  int   r = (int)(long)v->Data();
5515  int   c = (int)(long)w->Data();
5516  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5517  {
5518    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5519           r,c,u->Fullname(),bim->rows(),bim->cols());
5520    return TRUE;
5521  }
5522  res->data=u->data; u->data=NULL;
5523  res->rtyp=u->rtyp; u->rtyp=0;
5524  res->name=u->name; u->name=NULL;
5525  Subexpr e=jjMakeSub(v);
5526          e->next=jjMakeSub(w);
5527  if (u->e==NULL)
5528    res->e=e;
5529  else
5530  {
5531    Subexpr h=u->e;
5532    while (h->next!=NULL) h=h->next;
5533    h->next=e;
5534    res->e=u->e;
5535    u->e=NULL;
5536  }
5537  return FALSE;
5538}
5539static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5540{
5541  matrix m= (matrix)u->Data();
5542  int   r = (int)(long)v->Data();
5543  int   c = (int)(long)w->Data();
5544  //Print("gen. elem %d, %d\n",r,c);
5545  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5546  {
5547    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5548      MATROWS(m),MATCOLS(m));
5549    return TRUE;
5550  }
5551  res->data=u->data; u->data=NULL;
5552  res->rtyp=u->rtyp; u->rtyp=0;
5553  res->name=u->name; u->name=NULL;
5554  Subexpr e=jjMakeSub(v);
5555          e->next=jjMakeSub(w);
5556  if (u->e==NULL)
5557    res->e=e;
5558  else
5559  {
5560    Subexpr h=u->e;
5561    while (h->next!=NULL) h=h->next;
5562    h->next=e;
5563    res->e=u->e;
5564    u->e=NULL;
5565  }
5566  return FALSE;
5567}
5568static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5569{
5570  sleftv t;
5571  sleftv ut;
5572  leftv p=NULL;
5573  intvec *iv=(intvec *)w->Data();
5574  int l;
5575  BOOLEAN nok;
5576
5577  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5578  {
5579    WerrorS("cannot build expression lists from unnamed objects");
5580    return TRUE;
5581  }
5582  memcpy(&ut,u,sizeof(ut));
5583  memset(&t,0,sizeof(t));
5584  t.rtyp=INT_CMD;
5585  for (l=0;l< iv->length(); l++)
5586  {
5587    t.data=(char *)(long)((*iv)[l]);
5588    if (p==NULL)
5589    {
5590      p=res;
5591    }
5592    else
5593    {
5594      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5595      p=p->next;
5596    }
5597    memcpy(u,&ut,sizeof(ut));
5598    if (u->Typ() == MATRIX_CMD)
5599      nok=jjBRACK_Ma(p,u,v,&t);
5600    else if (u->Typ() == BIGINTMAT_CMD)
5601      nok=jjBRACK_Bim(p,u,v,&t);
5602    else /* INTMAT_CMD */
5603      nok=jjBRACK_Im(p,u,v,&t);
5604    if (nok)
5605    {
5606      while (res->next!=NULL)
5607      {
5608        p=res->next->next;
5609        omFreeBin((ADDRESS)res->next, sleftv_bin);
5610        // res->e aufraeumen !!!!
5611        res->next=p;
5612      }
5613      return TRUE;
5614    }
5615  }
5616  return FALSE;
5617}
5618static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5619{
5620  sleftv t;
5621  sleftv ut;
5622  leftv p=NULL;
5623  intvec *iv=(intvec *)v->Data();
5624  int l;
5625  BOOLEAN nok;
5626
5627  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5628  {
5629    WerrorS("cannot build expression lists from unnamed objects");
5630    return TRUE;
5631  }
5632  memcpy(&ut,u,sizeof(ut));
5633  memset(&t,0,sizeof(t));
5634  t.rtyp=INT_CMD;
5635  for (l=0;l< iv->length(); l++)
5636  {
5637    t.data=(char *)(long)((*iv)[l]);
5638    if (p==NULL)
5639    {
5640      p=res;
5641    }
5642    else
5643    {
5644      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5645      p=p->next;
5646    }
5647    memcpy(u,&ut,sizeof(ut));
5648    if (u->Typ() == MATRIX_CMD)
5649      nok=jjBRACK_Ma(p,u,&t,w);
5650    else if (u->Typ() == BIGINTMAT_CMD)
5651      nok=jjBRACK_Bim(p,u,&t,w);
5652    else /* INTMAT_CMD */
5653      nok=jjBRACK_Im(p,u,&t,w);
5654    if (nok)
5655    {
5656      while (res->next!=NULL)
5657      {
5658        p=res->next->next;
5659        omFreeBin((ADDRESS)res->next, sleftv_bin);
5660        // res->e aufraeumen !!
5661        res->next=p;
5662      }
5663      return TRUE;
5664    }
5665  }
5666  return FALSE;
5667}
5668static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5669{
5670  sleftv t1,t2,ut;
5671  leftv p=NULL;
5672  intvec *vv=(intvec *)v->Data();
5673  intvec *wv=(intvec *)w->Data();
5674  int vl;
5675  int wl;
5676  BOOLEAN nok;
5677
5678  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5679  {
5680    WerrorS("cannot build expression lists from unnamed objects");
5681    return TRUE;
5682  }
5683  memcpy(&ut,u,sizeof(ut));
5684  memset(&t1,0,sizeof(sleftv));
5685  memset(&t2,0,sizeof(sleftv));
5686  t1.rtyp=INT_CMD;
5687  t2.rtyp=INT_CMD;
5688  for (vl=0;vl< vv->length(); vl++)
5689  {
5690    t1.data=(char *)(long)((*vv)[vl]);
5691    for (wl=0;wl< wv->length(); wl++)
5692    {
5693      t2.data=(char *)(long)((*wv)[wl]);
5694      if (p==NULL)
5695      {
5696        p=res;
5697      }
5698      else
5699      {
5700        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5701        p=p->next;
5702      }
5703      memcpy(u,&ut,sizeof(ut));
5704      if (u->Typ() == MATRIX_CMD)
5705        nok=jjBRACK_Ma(p,u,&t1,&t2);
5706      else if (u->Typ() == BIGINTMAT_CMD)
5707        nok=jjBRACK_Bim(p,u,&t1,&t2);
5708      else /* INTMAT_CMD */
5709        nok=jjBRACK_Im(p,u,&t1,&t2);
5710      if (nok)
5711      {
5712        res->CleanUp();
5713        return TRUE;
5714      }
5715    }
5716  }
5717  return FALSE;
5718}
5719static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5720{
5721  v->next=(leftv)omAllocBin(sleftv_bin);
5722  memcpy(v->next,w,sizeof(sleftv));
5723  memset(w,0,sizeof(sleftv));
5724  return jjPROC(res,u,v);
5725}
5726static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5727{
5728  intvec *iv;
5729  ideal m;
5730  lists l=(lists)omAllocBin(slists_bin);
5731  int k=(int)(long)w->Data();
5732  if (k>=0)
5733  {
5734    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5735    l->Init(2);
5736    l->m[0].rtyp=MODUL_CMD;
5737    l->m[1].rtyp=INTVEC_CMD;
5738    l->m[0].data=(void *)m;
5739    l->m[1].data=(void *)iv;
5740  }
5741  else
5742  {
5743    m=sm_CallSolv((ideal)u->Data(), currRing);
5744    l->Init(1);
5745    l->m[0].rtyp=IDEAL_CMD;
5746    l->m[0].data=(void *)m;
5747  }
5748  res->data = (char *)l;
5749  return FALSE;
5750}
5751static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5752{
5753  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5754  {
5755    WerrorS("3rd argument must be a name of a matrix");
5756    return TRUE;
5757  }
5758  ideal i=(ideal)u->Data();
5759  int rank=(int)i->rank;
5760  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5761  if (r) return TRUE;
5762  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5763  return FALSE;
5764}
5765static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5766{
5767  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5768           (ideal)(v->Data()),(poly)(w->Data()));
5769  return FALSE;
5770}
5771static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5772{
5773  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5774  {
5775    WerrorS("3rd argument must be a name of a matrix");
5776    return TRUE;
5777  }
5778  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5779  poly p=(poly)u->CopyD(POLY_CMD);
5780  ideal i=idInit(1,1);
5781  i->m[0]=p;
5782  sleftv t;
5783  memset(&t,0,sizeof(t));
5784  t.data=(char *)i;
5785  t.rtyp=IDEAL_CMD;
5786  int rank=1;