source: git/Singular/iparith.cc @ ea63bfc

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