source: git/Singular/iparith.cc @ d770e6

fieker-DuValspielwiese
Last change on this file since d770e6 was 741464, checked in by Hans Schoenemann <hannes@…>, 9 years ago
add: id_Shift
  • Property mode set to 100644
File size: 224.4 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  number n=n_ChineseRemainderSym(x,q,rl,FALSE,coeffs_BIGINT);
1673  for(i=rl-1;i>=0;i--)
1674  {
1675    n_Delete(&(q[i]),coeffs_BIGINT);
1676    n_Delete(&(x[i]),coeffs_BIGINT);
1677  }
1678  omFree(x); omFree(q);
1679  res->data=(char *)n;
1680  return FALSE;
1681}
1682#if 0
1683static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1684{
1685  lists c=(lists)u->CopyD(); // list of poly
1686  intvec* p=(intvec*)v->Data();
1687  int rl=p->length();
1688  poly r=NULL,h, result=NULL;
1689  number *x=(number *)omAlloc(rl*sizeof(number));
1690  number *q=(number *)omAlloc(rl*sizeof(number));
1691  int i;
1692  for(i=rl-1;i>=0;i--)
1693  {
1694    q[i]=nlInit((*p)[i]);
1695  }
1696  loop
1697  {
1698    for(i=rl-1;i>=0;i--)
1699    {
1700      if (c->m[i].Typ()!=POLY_CMD)
1701      {
1702        Werror("poly expected at pos %d",i+1);
1703        for(i=rl-1;i>=0;i--)
1704        {
1705          nlDelete(&(q[i]),currRing);
1706        }
1707        omFree(x); omFree(q); // delete c
1708        return TRUE;
1709      }
1710      h=((poly)c->m[i].Data());
1711      if (r==NULL) r=h;
1712      else if (pLmCmp(r,h)==-1) r=h;
1713    }
1714    if (r==NULL) break;
1715    for(i=rl-1;i>=0;i--)
1716    {
1717      h=((poly)c->m[i].Data());
1718      if (pLmCmp(r,h)==0)
1719      {
1720        x[i]=pGetCoeff(h);
1721        h=pLmFreeAndNext(h);
1722        c->m[i].data=(char*)h;
1723      }
1724      else
1725        x[i]=nlInit(0);
1726    }
1727    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1728    for(i=rl-1;i>=0;i--)
1729    {
1730      nlDelete(&(x[i]),currRing);
1731    }
1732    h=pHead(r);
1733    pSetCoeff(h,n);
1734    result=pAdd(result,h);
1735  }
1736  for(i=rl-1;i>=0;i--)
1737  {
1738    nlDelete(&(q[i]),currRing);
1739  }
1740  omFree(x); omFree(q);
1741  res->data=(char *)result;
1742  return FALSE;
1743}
1744#endif
1745static BOOLEAN jjALIGN_V(leftv res, leftv u, leftv v)
1746{
1747  poly p=(poly)u->CopyD();
1748  int s=(int)(long)v->Data();
1749  if (s+p_MinComp(p,currRing)<=0)
1750  { p_Delete(&p,currRing);return TRUE;}
1751  p_Shift(&p,s,currRing);
1752  res->data=p;
1753  return FALSE;
1754}
1755static BOOLEAN jjALIGN_M(leftv res, leftv u, leftv v)
1756{
1757  ideal M=(ideal)u->CopyD();
1758  int s=(int)(long)v->Data();
1759  for(int i=IDELEMS(M)-1; i>=0;i--)
1760  {
1761    if (s+p_MinComp(M->m[i],currRing)<=0)
1762    { id_Delete(&M,currRing);return TRUE;}
1763  }
1764  id_Shift(M,s,currRing);
1765  res->data=M;
1766  return FALSE;
1767}
1768static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1769{
1770  coeffs cf;
1771  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
1772  lists pl=NULL;
1773  intvec *p=NULL;
1774  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1775  else                    p=(intvec*)v->Data();
1776  int rl=c->nr+1;
1777  ideal result;
1778  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1779  number *xx=NULL;
1780  int i;
1781  int return_type=c->m[0].Typ();
1782  if ((return_type!=IDEAL_CMD)
1783  && (return_type!=MODUL_CMD)
1784  && (return_type!=MATRIX_CMD)
1785  && (return_type!=POLY_CMD))
1786  {
1787    if((return_type!=BIGINT_CMD)&&(return_type!=INT_CMD))
1788    {
1789      WerrorS("poly/ideal/module/matrix expected");
1790      omFree(x); // delete c
1791      return TRUE;
1792    }
1793    else
1794      return_type=BIGINT_CMD;
1795  }
1796  if (return_type==BIGINT_CMD)
1797    cf=coeffs_BIGINT;
1798  else
1799  {
1800    cf=currRing->cf;
1801    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
1802      cf=cf->extRing->cf;
1803  }
1804  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
1805  if (return_type!=BIGINT_CMD)
1806  {
1807    for(i=rl-1;i>=0;i--)
1808    {
1809      if (c->m[i].Typ()!=return_type)
1810      {
1811        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1812        omFree(x); // delete c
1813        return TRUE;
1814      }
1815      if (return_type==POLY_CMD)
1816      {
1817        x[i]=idInit(1,1);
1818        x[i]->m[0]=(poly)c->m[i].CopyD();
1819      }
1820      else
1821      {
1822        x[i]=(ideal)c->m[i].CopyD();
1823      }
1824      //c->m[i].Init();
1825    }
1826  }
1827  else
1828  {
1829    xx=(number *)omAlloc(rl*sizeof(number));
1830    if (nMap==NULL)
1831    {
1832      Werror("not implemented: map bigint -> %s", nCoeffString(cf));
1833      return TRUE;
1834    }
1835    for(i=rl-1;i>=0;i--)
1836    {
1837      if (c->m[i].Typ()==INT_CMD)
1838      {
1839        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
1840      }
1841      else if (c->m[i].Typ()==BIGINT_CMD)
1842      {
1843        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
1844      }
1845      else
1846      {
1847        Werror("bigint expected at pos %d",i+1);
1848        omFree(x); // delete c
1849        omFree(xx); // delete c
1850        return TRUE;
1851      }
1852    }
1853  }
1854  number *q=(number *)omAlloc(rl*sizeof(number));
1855  if (p!=NULL)
1856  {
1857    for(i=rl-1;i>=0;i--)
1858    {
1859      q[i]=n_Init((*p)[i], cf);
1860    }
1861  }
1862  else
1863  {
1864    for(i=rl-1;i>=0;i--)
1865    {
1866      if (pl->m[i].Typ()==INT_CMD)
1867      {
1868        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
1869      }
1870      else if (pl->m[i].Typ()==BIGINT_CMD)
1871      {
1872        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
1873      }
1874      else
1875      {
1876        Werror("bigint expected at pos %d",i+1);
1877        for(i++;i<rl;i++)
1878        {
1879          n_Delete(&(q[i]),cf);
1880        }
1881        omFree(x); // delete c
1882        omFree(q); // delete pl
1883        if (xx!=NULL) omFree(xx); // delete c
1884        return TRUE;
1885      }
1886    }
1887  }
1888  if (return_type==BIGINT_CMD)
1889  {
1890    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,coeffs_BIGINT);
1891    res->data=(char *)n;
1892  }
1893  else
1894  {
1895    result=id_ChineseRemainder(x,q,rl,currRing);
1896    // deletes also x
1897    c->Clean();
1898    if (return_type==POLY_CMD)
1899    {
1900      res->data=(char *)result->m[0];
1901      result->m[0]=NULL;
1902      idDelete(&result);
1903    }
1904    else
1905      res->data=(char *)result;
1906  }
1907  for(i=rl-1;i>=0;i--)
1908  {
1909    n_Delete(&(q[i]),cf);
1910  }
1911  omFree(q);
1912  res->rtyp=return_type;
1913  return FALSE;
1914}
1915static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1916{
1917  poly p=(poly)v->Data();
1918  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1919  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1920  return FALSE;
1921}
1922static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1923{
1924  int i=pVar((poly)v->Data());
1925  if (i==0)
1926  {
1927    WerrorS("ringvar expected");
1928    return TRUE;
1929  }
1930  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1931  return FALSE;
1932}
1933static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1934{
1935  poly p = pInit();
1936  int i;
1937  for (i=1; i<=currRing->N; i++)
1938  {
1939    pSetExp(p, i, 1);
1940  }
1941  pSetm(p);
1942  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1943                                    (ideal)(v->Data()), p);
1944  pDelete(&p);
1945  return FALSE;
1946}
1947static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1948{
1949  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1950  return FALSE;
1951}
1952static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1953{
1954  short *iv=iv2array((intvec *)v->Data(),currRing);
1955  ideal I=(ideal)u->Data();
1956  int d=-1;
1957  int i;
1958  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)p_DegW(I->m[i],iv,currRing));
1959  omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1960  res->data = (char *)((long)d);
1961  return FALSE;
1962}
1963static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1964{
1965  poly p=(poly)u->Data();
1966  if (p!=NULL)
1967  {
1968    short *iv=iv2array((intvec *)v->Data(),currRing);
1969    const long d = p_DegW(p,iv,currRing);
1970    omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1971    res->data = (char *)(d);
1972  }
1973  else
1974    res->data=(char *)(long)(-1);
1975  return FALSE;
1976}
1977static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1978{
1979  int i=pVar((poly)v->Data());
1980  if (i==0)
1981  {
1982    WerrorS("ringvar expected");
1983    return TRUE;
1984  }
1985  res->data=(char *)pDiff((poly)(u->Data()),i);
1986  return FALSE;
1987}
1988static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1989{
1990  int i=pVar((poly)v->Data());
1991  if (i==0)
1992  {
1993    WerrorS("ringvar expected");
1994    return TRUE;
1995  }
1996  res->data=(char *)idDiff((matrix)(u->Data()),i);
1997  return FALSE;
1998}
1999static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
2000{
2001  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
2002  return FALSE;
2003}
2004static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
2005{
2006  assumeStdFlag(v);
2007#ifdef HAVE_RINGS
2008  if (rField_is_Ring(currRing))
2009  {
2010    //ring origR = currRing;
2011    //ring tempR = rCopy(origR);
2012    //coeffs new_cf=nInitChar(n_Q,NULL);
2013    //nKillChar(tempR->cf);
2014    //tempR->cf=new_cf;
2015    //rComplete(tempR);
2016    ideal vid = (ideal)v->Data();
2017    int i = idPosConstant(vid);
2018    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
2019    { /* ideal v contains unit; dim = -1 */
2020      res->data = (char *)-1;
2021      return FALSE;
2022    }
2023    //rChangeCurrRing(tempR);
2024    //ideal vv = idrCopyR(vid, origR, currRing);
2025    ideal vv = id_Copy(vid, currRing);
2026    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
2027    ideal ww = id_Copy((ideal)w->Data(), currRing);
2028    /* drop degree zero generator from vv (if any) */
2029    if (i != -1) pDelete(&vv->m[i]);
2030    long d = (long)scDimInt(vv, ww);
2031    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
2032    res->data = (char *)d;
2033    idDelete(&vv); idDelete(&ww);
2034    //rChangeCurrRing(origR);
2035    //rDelete(tempR);
2036    return FALSE;
2037  }
2038#endif
2039  if(currRing->qideal==NULL)
2040    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
2041  else
2042  {
2043    ideal q=idSimpleAdd(currRing->qideal,(ideal)w->Data());
2044    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
2045    idDelete(&q);
2046  }
2047  return FALSE;
2048}
2049static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
2050{
2051  ideal vi=(ideal)v->Data();
2052  int vl= IDELEMS(vi);
2053  ideal ui=(ideal)u->Data();
2054  int ul= IDELEMS(ui);
2055  ideal R; matrix U;
2056  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
2057  if (m==NULL) return TRUE;
2058  // now make sure that all matices have the corect size:
2059  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
2060  int i;
2061  if (MATCOLS(U) != ul)
2062  {
2063    int mul=si_min(ul,MATCOLS(U));
2064    matrix UU=mpNew(ul,ul);
2065    int j;
2066    for(i=mul;i>0;i--)
2067    {
2068      for(j=mul;j>0;j--)
2069      {
2070        MATELEM(UU,i,j)=MATELEM(U,i,j);
2071        MATELEM(U,i,j)=NULL;
2072      }
2073    }
2074    idDelete((ideal *)&U);
2075    U=UU;
2076  }
2077  // make sure that U is a diagonal matrix of units
2078  for(i=ul;i>0;i--)
2079  {
2080    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
2081  }
2082  lists L=(lists)omAllocBin(slists_bin);
2083  L->Init(3);
2084  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
2085  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
2086  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
2087  res->data=(char *)L;
2088  return FALSE;
2089}
2090static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
2091{
2092  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
2093  //setFlag(res,FLAG_STD);
2094  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
2095}
2096static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
2097{
2098  poly p=pOne();
2099  intvec *iv=(intvec*)v->Data();
2100  for(int i=iv->length()-1; i>=0; i--)
2101  {
2102    pSetExp(p,(*iv)[i],1);
2103  }
2104  pSetm(p);
2105  res->data=(char *)idElimination((ideal)u->Data(),p);
2106  pLmDelete(&p);
2107  //setFlag(res,FLAG_STD);
2108  return FALSE;
2109}
2110static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
2111{
2112  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
2113  return iiExport(v,0,IDPACKAGE((idhdl)u->data));
2114}
2115static BOOLEAN jjERROR(leftv, leftv u)
2116{
2117  WerrorS((char *)u->Data());
2118  extern int inerror;
2119  inerror=3;
2120  return TRUE;
2121}
2122static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
2123{
2124  number uu=(number)u->Data();number vv=(number)v->Data();
2125  lists L=(lists)omAllocBin(slists_bin);
2126  number a,b;
2127  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
2128  L->Init(3);
2129  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
2130  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
2131  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
2132  res->rtyp=LIST_CMD;
2133  res->data=(char *)L;
2134  return FALSE;
2135}
2136static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
2137{
2138  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2139  int p0=ABS(uu),p1=ABS(vv);
2140  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2141
2142  while ( p1!=0 )
2143  {
2144    q=p0 / p1;
2145    r=p0 % p1;
2146    p0 = p1; p1 = r;
2147    r = g0 - g1 * q;
2148    g0 = g1; g1 = r;
2149    r = f0 - f1 * q;
2150    f0 = f1; f1 = r;
2151  }
2152  int a = f0;
2153  int b = g0;
2154  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2155  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2156  lists L=(lists)omAllocBin(slists_bin);
2157  L->Init(3);
2158  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2159  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2160  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2161  res->rtyp=LIST_CMD;
2162  res->data=(char *)L;
2163  return FALSE;
2164}
2165static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2166{
2167  poly r,pa,pb;
2168  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2169  if (ret) return TRUE;
2170  lists L=(lists)omAllocBin(slists_bin);
2171  L->Init(3);
2172  res->data=(char *)L;
2173  L->m[0].data=(void *)r;
2174  L->m[0].rtyp=POLY_CMD;
2175  L->m[1].data=(void *)pa;
2176  L->m[1].rtyp=POLY_CMD;
2177  L->m[2].data=(void *)pb;
2178  L->m[2].rtyp=POLY_CMD;
2179  return FALSE;
2180}
2181extern int singclap_factorize_retry;
2182static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2183{
2184  intvec *v=NULL;
2185  int sw=(int)(long)dummy->Data();
2186  int fac_sw=sw;
2187  if ((sw<0)||(sw>2)) fac_sw=1;
2188  singclap_factorize_retry=0;
2189  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2190  if (f==NULL)
2191    return TRUE;
2192  switch(sw)
2193  {
2194    case 0:
2195    case 2:
2196    {
2197      lists l=(lists)omAllocBin(slists_bin);
2198      l->Init(2);
2199      l->m[0].rtyp=IDEAL_CMD;
2200      l->m[0].data=(void *)f;
2201      l->m[1].rtyp=INTVEC_CMD;
2202      l->m[1].data=(void *)v;
2203      res->data=(void *)l;
2204      res->rtyp=LIST_CMD;
2205      return FALSE;
2206    }
2207    case 1:
2208      res->data=(void *)f;
2209      return FALSE;
2210    case 3:
2211      {
2212        poly p=f->m[0];
2213        int i=IDELEMS(f);
2214        f->m[0]=NULL;
2215        while(i>1)
2216        {
2217          i--;
2218          p=pMult(p,f->m[i]);
2219          f->m[i]=NULL;
2220        }
2221        res->data=(void *)p;
2222        res->rtyp=POLY_CMD;
2223      }
2224      return FALSE;
2225  }
2226  WerrorS("invalid switch");
2227  return TRUE;
2228}
2229static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2230{
2231  ideal_list p,h;
2232  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2233  p=h;
2234  int l=0;
2235  while (p!=NULL) { p=p->next;l++; }
2236  lists L=(lists)omAllocBin(slists_bin);
2237  L->Init(l);
2238  l=0;
2239  while(h!=NULL)
2240  {
2241    L->m[l].data=(char *)h->d;
2242    L->m[l].rtyp=IDEAL_CMD;
2243    p=h->next;
2244    omFreeSize(h,sizeof(*h));
2245    h=p;
2246    l++;
2247  }
2248  res->data=(void *)L;
2249  return FALSE;
2250}
2251static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2252{
2253  if (rField_is_Q(currRing))
2254  {
2255    number uu=(number)u->Data();
2256    number vv=(number)v->Data();
2257    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2258    return FALSE;
2259  }
2260  else return TRUE;
2261}
2262static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2263{
2264  ideal uu=(ideal)u->Data();
2265  number vv=(number)v->Data();
2266  res->data=(void*)id_Farey(uu,vv,currRing);
2267  res->rtyp=u->Typ();
2268  return FALSE;
2269}
2270static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2271{
2272  ring r=(ring)u->Data();
2273  idhdl w;
2274  int op=iiOp;
2275  nMapFunc nMap;
2276
2277  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2278  {
2279    int *perm=NULL;
2280    int *par_perm=NULL;
2281    int par_perm_size=0;
2282    BOOLEAN bo;
2283    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2284    {
2285      // Allow imap/fetch to be make an exception only for:
2286      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2287            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2288             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2289           ||
2290           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2291            (rField_is_Zp(currRing, r->cf->ch) ||
2292             rField_is_Zp_a(currRing, r->cf->ch))) )
2293      {
2294        par_perm_size=rPar(r);
2295      }
2296      else
2297      {
2298        goto err_fetch;
2299      }
2300    }
2301    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2302    {
2303      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2304      if (par_perm_size!=0)
2305        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2306      op=IMAP_CMD;
2307      if (iiOp==IMAP_CMD)
2308      {
2309        int r_par=0;
2310        char ** r_par_names=NULL;
2311        if (r->cf->extRing!=NULL)
2312        {
2313          r_par=r->cf->extRing->N;
2314          r_par_names=r->cf->extRing->names;
2315        }
2316        int c_par=0;
2317        char ** c_par_names=NULL;
2318        if (currRing->cf->extRing!=NULL)
2319        {
2320          c_par=currRing->cf->extRing->N;
2321          c_par_names=currRing->cf->extRing->names;
2322        }
2323        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2324                   currRing->names,currRing->N,c_par_names, c_par,
2325                   perm,par_perm, currRing->cf->type);
2326      }
2327      else
2328      {
2329        int i;
2330        if (par_perm_size!=0)
2331          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2332        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2333      }
2334    }
2335    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2336    {
2337      int i;
2338      for(i=0;i<si_min(r->N,currRing->N);i++)
2339      {
2340        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2341      }
2342      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2343      {
2344        Print("// par nr %d: %s -> %s\n",
2345              i,rParameter(r)[i],rParameter(currRing)[i]);
2346      }
2347    }
2348    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
2349    sleftv tmpW;
2350    memset(&tmpW,0,sizeof(sleftv));
2351    tmpW.rtyp=IDTYP(w);
2352    tmpW.data=IDDATA(w);
2353    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2354                         perm,par_perm,par_perm_size,nMap)))
2355    {
2356      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2357    }
2358    if (perm!=NULL)
2359      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2360    if (par_perm!=NULL)
2361      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2362    return bo;
2363  }
2364  else
2365  {
2366    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2367  }
2368  return TRUE;
2369err_fetch:
2370  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
2371         nCoeffString(r->cf),
2372         nCoeffString(currRing->cf));
2373  return TRUE;
2374}
2375static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2376{
2377  /*4
2378  * look for the substring what in the string where
2379  * return the position of the first char of what in where
2380  * or 0
2381  */
2382  char *where=(char *)u->Data();
2383  char *what=(char *)v->Data();
2384  char *found = strstr(where,what);
2385  if (found != NULL)
2386  {
2387    res->data=(char *)((found-where)+1);
2388  }
2389  /*else res->data=NULL;*/
2390  return FALSE;
2391}
2392static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2393{
2394  res->data=(char *)fractalWalkProc(u,v);
2395  setFlag( res, FLAG_STD );
2396  return FALSE;
2397}
2398static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2399{
2400  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2401  int p0=ABS(uu),p1=ABS(vv);
2402  int r;
2403  while ( p1!=0 )
2404  {
2405    r=p0 % p1;
2406    p0 = p1; p1 = r;
2407  }
2408  res->rtyp=INT_CMD;
2409  res->data=(char *)(long)p0;
2410  return FALSE;
2411}
2412static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2413{
2414  number n1 = (number) u->Data();
2415  number n2 = (number) v->Data();
2416  res->data = n_Gcd(n1,n2,coeffs_BIGINT);
2417  return FALSE;
2418}
2419static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2420{
2421  number a=(number) u->Data();
2422  number b=(number) v->Data();
2423  if (nIsZero(a))
2424  {
2425    if (nIsZero(b)) res->data=(char *)nInit(1);
2426    else            res->data=(char *)nCopy(b);
2427  }
2428  else
2429  {
2430    if (nIsZero(b))  res->data=(char *)nCopy(a);
2431    //else res->data=(char *)n_Gcd(a, b, currRing->cf);
2432    else res->data=(char *)n_SubringGcd(a, b, currRing->cf);
2433  }
2434  return FALSE;
2435}
2436static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2437{
2438  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2439                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2440  return FALSE;
2441}
2442static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2443{
2444#ifdef HAVE_RINGS
2445  if (rField_is_Ring_Z(currRing))
2446  {
2447    ring origR = currRing;
2448    ring tempR = rCopy(origR);
2449    coeffs new_cf=nInitChar(n_Q,NULL);
2450    nKillChar(tempR->cf);
2451    tempR->cf=new_cf;
2452    rComplete(tempR);
2453    ideal uid = (ideal)u->Data();
2454    rChangeCurrRing(tempR);
2455    ideal uu = idrCopyR(uid, origR, currRing);
2456    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2457    uuAsLeftv.rtyp = IDEAL_CMD;
2458    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2459    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2460    assumeStdFlag(&uuAsLeftv);
2461    Print("// NOTE: computation of Hilbert series etc. is being\n");
2462    Print("//       performed for generic fibre, that is, over Q\n");
2463    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2464    intvec *iv=hFirstSeries(uu,module_w,currRing->qideal);
2465    int returnWithTrue = 1;
2466    switch((int)(long)v->Data())
2467    {
2468      case 1:
2469        res->data=(void *)iv;
2470        returnWithTrue = 0;
2471      case 2:
2472        res->data=(void *)hSecondSeries(iv);
2473        delete iv;
2474        returnWithTrue = 0;
2475    }
2476    if (returnWithTrue)
2477    {
2478      WerrorS(feNotImplemented);
2479      delete iv;
2480    }
2481    idDelete(&uu);
2482    rChangeCurrRing(origR);
2483    rDelete(tempR);
2484    if (returnWithTrue) return TRUE; else return FALSE;
2485  }
2486#endif
2487  assumeStdFlag(u);
2488  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2489  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal);
2490  switch((int)(long)v->Data())
2491  {
2492    case 1:
2493      res->data=(void *)iv;
2494      return FALSE;
2495    case 2:
2496      res->data=(void *)hSecondSeries(iv);
2497      delete iv;
2498      return FALSE;
2499  }
2500  WerrorS(feNotImplemented);
2501  delete iv;
2502  return TRUE;
2503}
2504static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2505{
2506  int i=pVar((poly)v->Data());
2507  if (i==0)
2508  {
2509    WerrorS("ringvar expected");
2510    return TRUE;
2511  }
2512  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2513  int d=pWTotaldegree(p);
2514  pLmDelete(p);
2515  if (d==1)
2516    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2517  else
2518    WerrorS("variable must have weight 1");
2519  return (d!=1);
2520}
2521static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2522{
2523  int i=pVar((poly)v->Data());
2524  if (i==0)
2525  {
2526    WerrorS("ringvar expected");
2527    return TRUE;
2528  }
2529  pFDegProc deg;
2530  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2531    deg=p_Totaldegree;
2532   else
2533    deg=currRing->pFDeg;
2534  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2535  int d=deg(p,currRing);
2536  pLmDelete(p);
2537  if (d==1)
2538    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2539  else
2540    WerrorS("variable must have weight 1");
2541  return (d!=1);
2542}
2543static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2544{
2545  intvec *w=new intvec(rVar(currRing));
2546  intvec *vw=(intvec*)u->Data();
2547  ideal v_id=(ideal)v->Data();
2548  pFDegProc save_FDeg=currRing->pFDeg;
2549  pLDegProc save_LDeg=currRing->pLDeg;
2550  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2551  currRing->pLexOrder=FALSE;
2552  kHomW=vw;
2553  kModW=w;
2554  pSetDegProcs(currRing,kHomModDeg);
2555  res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
2556  currRing->pLexOrder=save_pLexOrder;
2557  kHomW=NULL;
2558  kModW=NULL;
2559  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2560  if (w!=NULL) delete w;
2561  return FALSE;
2562}
2563static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2564{
2565  assumeStdFlag(u);
2566  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2567                    currRing->qideal);
2568  return FALSE;
2569}
2570static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2571{
2572  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2573  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2574  return FALSE;
2575}
2576static BOOLEAN jjINTERPOLATION (leftv res, leftv l, leftv v)
2577{
2578  const lists L = (lists)l->Data();
2579  const int n = L->nr; assume (n >= 0);
2580  std::vector<ideal> V(n + 1);
2581
2582  for(int i = n; i >= 0; i--) V[i] = (ideal)(L->m[i].Data());
2583
2584  res->data=interpolation(V, (intvec*)v->Data());
2585  setFlag(res,FLAG_STD);
2586  return errorreported;
2587}
2588static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2589{
2590  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2591  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2592}
2593
2594static BOOLEAN jjJanetBasis(leftv res, leftv v)
2595{
2596  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2597  return jjStdJanetBasis(res,v,0);
2598}
2599static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2600{
2601  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2602  return FALSE;
2603}
2604static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2605{
2606  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2607  return FALSE;
2608}
2609static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2610{
2611  assumeStdFlag(u);
2612  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2613  res->data = (char *)scKBase((int)(long)v->Data(),
2614                              (ideal)(u->Data()),currRing->qideal, w_u);
2615  if (w_u!=NULL)
2616  {
2617    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2618  }
2619  return FALSE;
2620}
2621static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2622static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2623{
2624  return jjPREIMAGE(res,u,v,NULL);
2625}
2626static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2627{
2628  return mpKoszul(res, u,v,NULL);
2629}
2630static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2631{
2632  sleftv h;
2633  memset(&h,0,sizeof(sleftv));
2634  h.rtyp=INT_CMD;
2635  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2636  return mpKoszul(res, u, &h, v);
2637}
2638static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2639{
2640  int ul= IDELEMS((ideal)u->Data());
2641  int vl= IDELEMS((ideal)v->Data());
2642  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2643                   hasFlag(u,FLAG_STD));
2644  if (m==NULL) return TRUE;
2645  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2646  return FALSE;
2647}
2648static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2649{
2650  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2651  idhdl h=(idhdl)v->data;
2652  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2653  res->data = (char *)idLiftStd((ideal)u->Data(),
2654                                &(h->data.umatrix),testHomog);
2655  setFlag(res,FLAG_STD); v->flag=0;
2656  return FALSE;
2657}
2658static BOOLEAN jjLOAD2(leftv /*res*/, leftv, leftv v)
2659{
2660  return jjLOAD((char*)v->Data(),TRUE);
2661}
2662static BOOLEAN jjLOAD_E(leftv /*res*/, leftv v, leftv u)
2663{
2664  char * s=(char *)u->Data();
2665  if(strcmp(s, "with")==0)
2666    return jjLOAD((char*)v->Data(), TRUE);
2667  WerrorS("invalid second argument");
2668  WerrorS("load(\"libname\" [,\"with\"]);");
2669  return TRUE;
2670}
2671static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2672{
2673  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2674  tHomog hom=testHomog;
2675  if (w_u!=NULL)
2676  {
2677    w_u=ivCopy(w_u);
2678    hom=isHomog;
2679  }
2680  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2681  if (w_v!=NULL)
2682  {
2683    w_v=ivCopy(w_v);
2684    hom=isHomog;
2685  }
2686  if ((w_u!=NULL) && (w_v==NULL))
2687    w_v=ivCopy(w_u);
2688  if ((w_v!=NULL) && (w_u==NULL))
2689    w_u=ivCopy(w_v);
2690  ideal u_id=(ideal)u->Data();
2691  ideal v_id=(ideal)v->Data();
2692  if (w_u!=NULL)
2693  {
2694     if ((*w_u).compare((w_v))!=0)
2695     {
2696       WarnS("incompatible weights");
2697       delete w_u; w_u=NULL;
2698       hom=testHomog;
2699     }
2700     else
2701     {
2702       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
2703       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
2704       {
2705         WarnS("wrong weights");
2706         delete w_u; w_u=NULL;
2707         hom=testHomog;
2708       }
2709     }
2710  }
2711  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2712  if (w_u!=NULL)
2713  {
2714    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2715  }
2716  delete w_v;
2717  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2718  return FALSE;
2719}
2720static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2721{
2722  number q=(number)v->Data();
2723  if (n_IsZero(q,coeffs_BIGINT))
2724  {
2725    WerrorS(ii_div_by_0);
2726    return TRUE;
2727  }
2728  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2729  return FALSE;
2730}
2731static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2732{
2733  number q=(number)v->Data();
2734  if (nIsZero(q))
2735  {
2736    WerrorS(ii_div_by_0);
2737    return TRUE;
2738  }
2739  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2740  return FALSE;
2741}
2742static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2743static BOOLEAN jjMONITOR1(leftv res, leftv v)
2744{
2745  return jjMONITOR2(res,v,NULL);
2746}
2747static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2748{
2749#if 0
2750  char *opt=(char *)v->Data();
2751  int mode=0;
2752  while(*opt!='\0')
2753  {
2754    if (*opt=='i') mode |= SI_PROT_I;
2755    else if (*opt=='o') mode |= SI_PROT_O;
2756    opt++;
2757  }
2758  monitor((char *)(u->Data()),mode);
2759#else
2760  si_link l=(si_link)u->Data();
2761  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2762  if(strcmp(l->m->type,"ASCII")!=0)
2763  {
2764    Werror("ASCII link required, not `%s`",l->m->type);
2765    slClose(l);
2766    return TRUE;
2767  }
2768  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2769  if ( l->name[0]!='\0') // "" is the stop condition
2770  {
2771    const char *opt;
2772    int mode=0;
2773    if (v==NULL) opt=(const char*)"i";
2774    else         opt=(const char *)v->Data();
2775    while(*opt!='\0')
2776    {
2777      if (*opt=='i') mode |= SI_PROT_I;
2778      else if (*opt=='o') mode |= SI_PROT_O;
2779      opt++;
2780    }
2781    monitor((FILE *)l->data,mode);
2782  }
2783  else
2784    monitor(NULL,0);
2785  return FALSE;
2786#endif
2787}
2788static BOOLEAN jjMONOM(leftv res, leftv v)
2789{
2790  intvec *iv=(intvec *)v->Data();
2791  poly p=pOne();
2792  int i,e;
2793  BOOLEAN err=FALSE;
2794  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2795  {
2796    e=(*iv)[i-1];
2797    if (e>=0) pSetExp(p,i,e);
2798    else err=TRUE;
2799  }
2800  if (iv->length()==(currRing->N+1))
2801  {
2802    res->rtyp=VECTOR_CMD;
2803    e=(*iv)[currRing->N];
2804    if (e>=0) pSetComp(p,e);
2805    else err=TRUE;
2806  }
2807  pSetm(p);
2808  res->data=(char*)p;
2809  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2810  return err;
2811}
2812static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2813{
2814  // u: the name of the new type
2815  // v: the elements
2816  newstruct_desc d=newstructFromString((const char *)v->Data());
2817  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2818  return d==NULL;
2819}
2820static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2821{
2822  idhdl h=(idhdl)u->data;
2823  int i=(int)(long)v->Data();
2824  int p=0;
2825  if ((0<i)
2826  && (rParameter(IDRING(h))!=NULL)
2827  && (i<=(p=rPar(IDRING(h)))))
2828    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2829  else
2830  {
2831    Werror("par number %d out of range 1..%d",i,p);
2832    return TRUE;
2833  }
2834  return FALSE;
2835}
2836#ifdef HAVE_PLURAL
2837static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2838{
2839  if( currRing->qideal != NULL )
2840  {
2841    WerrorS("basering must NOT be a qring!");
2842    return TRUE;
2843  }
2844
2845  if (iiOp==NCALGEBRA_CMD)
2846  {
2847    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2848  }
2849  else
2850  {
2851    ring r=rCopy(currRing);
2852    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2853    res->data=r;
2854    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2855    return result;
2856  }
2857}
2858static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2859{
2860  if( currRing->qideal != NULL )
2861  {
2862    WerrorS("basering must NOT be a qring!");
2863    return TRUE;
2864  }
2865
2866  if (iiOp==NCALGEBRA_CMD)
2867  {
2868    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2869  }
2870  else
2871  {
2872    ring r=rCopy(currRing);
2873    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2874    res->data=r;
2875    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2876    return result;
2877  }
2878}
2879static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2880{
2881  if( currRing->qideal != NULL )
2882  {
2883    WerrorS("basering must NOT be a qring!");
2884    return TRUE;
2885  }
2886
2887  if (iiOp==NCALGEBRA_CMD)
2888  {
2889    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2890  }
2891  else
2892  {
2893    ring r=rCopy(currRing);
2894    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2895    res->data=r;
2896    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2897    return result;
2898  }
2899}
2900static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2901{
2902  if( currRing->qideal != NULL )
2903  {
2904    WerrorS("basering must NOT be a qring!");
2905    return TRUE;
2906  }
2907
2908  if (iiOp==NCALGEBRA_CMD)
2909  {
2910    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2911  }
2912  else
2913  {
2914    ring r=rCopy(currRing);
2915    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2916    res->data=r;
2917    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2918    return result;
2919  }
2920}
2921static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2922{
2923  res->data=NULL;
2924
2925  if (rIsPluralRing(currRing))
2926  {
2927    const poly q = (poly)b->Data();
2928
2929    if( q != NULL )
2930    {
2931      if( (poly)a->Data() != NULL )
2932      {
2933        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2934        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2935      }
2936    }
2937  }
2938  return FALSE;
2939}
2940static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2941{
2942  /* number, poly, vector, ideal, module, matrix */
2943  ring  r = (ring)a->Data();
2944  if (r == currRing)
2945  {
2946    res->data = b->Data();
2947    res->rtyp = b->rtyp;
2948    return FALSE;
2949  }
2950  if (!rIsLikeOpposite(currRing, r))
2951  {
2952    Werror("%s is not an opposite ring to current ring",a->Fullname());
2953    return TRUE;
2954  }
2955  idhdl w;
2956  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2957  {
2958    int argtype = IDTYP(w);
2959    switch (argtype)
2960    {
2961    case NUMBER_CMD:
2962      {
2963        /* since basefields are equal, we can apply nCopy */
2964        res->data = nCopy((number)IDDATA(w));
2965        res->rtyp = argtype;
2966        break;
2967      }
2968    case POLY_CMD:
2969    case VECTOR_CMD:
2970      {
2971        poly    q = (poly)IDDATA(w);
2972        res->data = pOppose(r,q,currRing);
2973        res->rtyp = argtype;
2974        break;
2975      }
2976    case IDEAL_CMD:
2977    case MODUL_CMD:
2978      {
2979        ideal   Q = (ideal)IDDATA(w);
2980        res->data = idOppose(r,Q,currRing);
2981        res->rtyp = argtype;
2982        break;
2983      }
2984    case MATRIX_CMD:
2985      {
2986        ring save = currRing;
2987        rChangeCurrRing(r);
2988        matrix  m = (matrix)IDDATA(w);
2989        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2990        rChangeCurrRing(save);
2991        ideal   S = idOppose(r,Q,currRing);
2992        id_Delete(&Q, r);
2993        res->data = id_Module2Matrix(S,currRing);
2994        res->rtyp = argtype;
2995        break;
2996      }
2997    default:
2998      {
2999        WerrorS("unsupported type in oppose");
3000        return TRUE;
3001      }
3002    }
3003  }
3004  else
3005  {
3006    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
3007    return TRUE;
3008  }
3009  return FALSE;
3010}
3011#endif /* HAVE_PLURAL */
3012
3013static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
3014{
3015  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
3016    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
3017  id_DelMultiples((ideal)(res->data),currRing);
3018  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
3019  return FALSE;
3020}
3021static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
3022{
3023  int i=(int)(long)u->Data();
3024  int j=(int)(long)v->Data();
3025  if (j-i <0) {WerrorS("invalid range for random"); return TRUE;}
3026  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
3027  return FALSE;
3028}
3029static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
3030{
3031  matrix m =(matrix)u->Data();
3032  int isRowEchelon = (int)(long)v->Data();
3033  if (isRowEchelon != 1) isRowEchelon = 0;
3034  int rank = luRank(m, isRowEchelon);
3035  res->data =(char *)(long)rank;
3036  return FALSE;
3037}
3038static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
3039{
3040  si_link l=(si_link)u->Data();
3041  leftv r=slRead(l,v);
3042  if (r==NULL)
3043  {
3044    const char *s;
3045    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3046    else                            s=sNoName;
3047    Werror("cannot read from `%s`",s);
3048    return TRUE;
3049  }
3050  memcpy(res,r,sizeof(sleftv));
3051  omFreeBin((ADDRESS)r, sleftv_bin);
3052  return FALSE;
3053}
3054static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
3055{
3056  assumeStdFlag(v);
3057  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data());
3058  return FALSE;
3059}
3060static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
3061{
3062  assumeStdFlag(v);
3063  ideal ui=(ideal)u->Data();
3064  ideal vi=(ideal)v->Data();
3065  res->data = (char *)kNF(vi,currRing->qideal,ui);
3066  return FALSE;
3067}
3068#if 0
3069static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3070{
3071  int maxl=(int)(long)v->Data();
3072  if (maxl<0)
3073  {
3074    WerrorS("length for res must not be negative");
3075    return TRUE;
3076  }
3077  int l=0;
3078  //resolvente r;
3079  syStrategy r;
3080  intvec *weights=NULL;
3081  int wmaxl=maxl;
3082  ideal u_id=(ideal)u->Data();
3083
3084  maxl--;
3085  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3086  {
3087    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3088    if (currRing->qideal!=NULL)
3089    {
3090      Warn(
3091      "full resolution in a qring may be infinite, setting max length to %d",
3092      maxl+1);
3093    }
3094  }
3095  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3096  if (weights!=NULL)
3097  {
3098    if (!idTestHomModule(u_id,currRing->qideal,weights))
3099    {
3100      WarnS("wrong weights given:");weights->show();PrintLn();
3101      weights=NULL;
3102    }
3103  }
3104  intvec *ww=NULL;
3105  int add_row_shift=0;
3106  if (weights!=NULL)
3107  {
3108     ww=ivCopy(weights);
3109     add_row_shift = ww->min_in();
3110     (*ww) -= add_row_shift;
3111  }
3112  else
3113    idHomModule(u_id,currRing->qideal,&ww);
3114  weights=ww;
3115
3116  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3117  {
3118    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3119  }
3120  else if (iiOp==SRES_CMD)
3121  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3122    r=sySchreyer(u_id,maxl+1);
3123  else if (iiOp == LRES_CMD)
3124  {
3125    int dummy;
3126    if((currRing->qideal!=NULL)||
3127    (!idHomIdeal (u_id,NULL)))
3128    {
3129       WerrorS
3130       ("`lres` not implemented for inhomogeneous input or qring");
3131       return TRUE;
3132    }
3133    r=syLaScala3(u_id,&dummy);
3134  }
3135  else if (iiOp == KRES_CMD)
3136  {
3137    int dummy;
3138    if((currRing->qideal!=NULL)||
3139    (!idHomIdeal (u_id,NULL)))
3140    {
3141       WerrorS
3142       ("`kres` not implemented for inhomogeneous input or qring");
3143       return TRUE;
3144    }
3145    r=syKosz(u_id,&dummy);
3146  }
3147  else
3148  {
3149    int dummy;
3150    if((currRing->qideal!=NULL)||
3151    (!idHomIdeal (u_id,NULL)))
3152    {
3153       WerrorS
3154       ("`hres` not implemented for inhomogeneous input or qring");
3155       return TRUE;
3156    }
3157    r=syHilb(u_id,&dummy);
3158  }
3159  if (r==NULL) return TRUE;
3160  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3161  r->list_length=wmaxl;
3162  res->data=(void *)r;
3163  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3164  {
3165    intvec *w=ivCopy(r->weights[0]);
3166    if (weights!=NULL) (*w) += add_row_shift;
3167    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3168    w=NULL;
3169  }
3170  else
3171  {
3172//#if 0
3173// need to set weights for ALL components (sres)
3174    if (weights!=NULL)
3175    {
3176      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3177      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3178      (r->weights)[0] = ivCopy(weights);
3179    }
3180//#endif
3181  }
3182  if (ww!=NULL) { delete ww; ww=NULL; }
3183  return FALSE;
3184}
3185#else
3186static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3187{
3188  int maxl=(int)(long)v->Data();
3189  if (maxl<0)
3190  {
3191    WerrorS("length for res must not be negative");
3192    return TRUE;
3193  }
3194  syStrategy r;
3195  intvec *weights=NULL;
3196  int wmaxl=maxl;
3197  ideal u_id=(ideal)u->Data();
3198
3199  maxl--;
3200  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3201  {
3202    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3203    if (currRing->qideal!=NULL)
3204    {
3205      Warn(
3206      "full resolution in a qring may be infinite, setting max length to %d",
3207      maxl+1);
3208    }
3209  }
3210  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3211  if (weights!=NULL)
3212  {
3213    if (!idTestHomModule(u_id,currRing->qideal,weights))
3214    {
3215      WarnS("wrong weights given:");weights->show();PrintLn();
3216      weights=NULL;
3217    }
3218  }
3219  intvec *ww=NULL;
3220  int add_row_shift=0;
3221  if (weights!=NULL)
3222  {
3223     ww=ivCopy(weights);
3224     add_row_shift = ww->min_in();
3225     (*ww) -= add_row_shift;
3226  }
3227  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3228  {
3229    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3230  }
3231  else if (iiOp==SRES_CMD)
3232  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3233    r=sySchreyer(u_id,maxl+1);
3234  else if (iiOp == LRES_CMD)
3235  {
3236    int dummy;
3237    if((currRing->qideal!=NULL)||
3238    (!idHomIdeal (u_id,NULL)))
3239    {
3240       WerrorS
3241       ("`lres` not implemented for inhomogeneous input or qring");
3242       return TRUE;
3243    }
3244    if(currRing->N == 1)
3245      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3246    r=syLaScala3(u_id,&dummy);
3247  }
3248  else if (iiOp == KRES_CMD)
3249  {
3250    int dummy;
3251    if((currRing->qideal!=NULL)||
3252    (!idHomIdeal (u_id,NULL)))
3253    {
3254       WerrorS
3255       ("`kres` not implemented for inhomogeneous input or qring");
3256       return TRUE;
3257    }
3258    r=syKosz(u_id,&dummy);
3259  }
3260  else
3261  {
3262    int dummy;
3263    if((currRing->qideal!=NULL)||
3264    (!idHomIdeal (u_id,NULL)))
3265    {
3266       WerrorS
3267       ("`hres` not implemented for inhomogeneous input or qring");
3268       return TRUE;
3269    }
3270    ideal u_id_copy=idCopy(u_id);
3271    idSkipZeroes(u_id_copy);
3272    r=syHilb(u_id_copy,&dummy);
3273    idDelete(&u_id_copy);
3274  }
3275  if (r==NULL) return TRUE;
3276  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3277  r->list_length=wmaxl;
3278  res->data=(void *)r;
3279  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3280  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3281  {
3282    ww=ivCopy(r->weights[0]);
3283    if (weights!=NULL) (*ww) += add_row_shift;
3284    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3285  }
3286  else
3287  {
3288    if (weights!=NULL)
3289    {
3290      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3291    }
3292  }
3293
3294  // test the La Scala case' output
3295  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3296  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3297
3298  if(iiOp != HRES_CMD)
3299    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3300  else
3301    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3302
3303  return FALSE;
3304}
3305#endif
3306static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3307{
3308  number n1; int i;
3309
3310  if ((u->Typ() == BIGINT_CMD) ||
3311     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3312  {
3313    n1 = (number)u->CopyD();
3314  }
3315  else if (u->Typ() == INT_CMD)
3316  {
3317    i = (int)(long)u->Data();
3318    n1 = n_Init(i, coeffs_BIGINT);
3319  }
3320  else
3321  {
3322    return TRUE;
3323  }
3324
3325  i = (int)(long)v->Data();
3326
3327  lists l = primeFactorisation(n1, i);
3328  n_Delete(&n1, coeffs_BIGINT);
3329  res->data = (char*)l;
3330  return FALSE;
3331}
3332static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3333{
3334  ring r;
3335  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3336  res->data = (char *)r;
3337  return (i==-1);
3338}
3339#define SIMPL_LMDIV 32
3340#define SIMPL_LMEQ  16
3341#define SIMPL_MULT 8
3342#define SIMPL_EQU  4
3343#define SIMPL_NULL 2
3344#define SIMPL_NORM 1
3345static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3346{
3347  int sw = (int)(long)v->Data();
3348  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3349  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3350  if (sw & SIMPL_LMDIV)
3351  {
3352    id_DelDiv(id,currRing);
3353  }
3354  if (sw & SIMPL_LMEQ)
3355  {
3356    id_DelLmEquals(id,currRing);
3357  }
3358  if (sw & SIMPL_MULT)
3359  {
3360    id_DelMultiples(id,currRing);
3361  }
3362  else if(sw & SIMPL_EQU)
3363  {
3364    id_DelEquals(id,currRing);
3365  }
3366  if (sw & SIMPL_NULL)
3367  {
3368    idSkipZeroes(id);
3369  }
3370  if (sw & SIMPL_NORM)
3371  {
3372    id_Norm(id,currRing);
3373  }
3374  res->data = (char * )id;
3375  return FALSE;
3376}
3377extern int singclap_factorize_retry;
3378static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3379{
3380  intvec *v=NULL;
3381  int sw=(int)(long)dummy->Data();
3382  int fac_sw=sw;
3383  if (sw<0) fac_sw=1;
3384  singclap_factorize_retry=0;
3385  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3386  if (f==NULL)
3387    return TRUE;
3388  switch(sw)
3389  {
3390    case 0:
3391    case 2:
3392    {
3393      lists l=(lists)omAllocBin(slists_bin);
3394      l->Init(2);
3395      l->m[0].rtyp=IDEAL_CMD;
3396      l->m[0].data=(void *)f;
3397      l->m[1].rtyp=INTVEC_CMD;
3398      l->m[1].data=(void *)v;
3399      res->data=(void *)l;
3400      res->rtyp=LIST_CMD;
3401      return FALSE;
3402    }
3403    case 1:
3404      res->data=(void *)f;
3405      return FALSE;
3406    case 3:
3407      {
3408        poly p=f->m[0];
3409        int i=IDELEMS(f);
3410        f->m[0]=NULL;
3411        while(i>1)
3412        {
3413          i--;
3414          p=pMult(p,f->m[i]);
3415          f->m[i]=NULL;
3416        }
3417        res->data=(void *)p;
3418        res->rtyp=POLY_CMD;
3419      }
3420      return FALSE;
3421  }
3422  WerrorS("invalid switch");
3423  return FALSE;
3424}
3425static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3426{
3427  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3428  return FALSE;
3429}
3430static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3431{
3432  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3433  //return (res->data== (void*)(long)-2);
3434  return FALSE;
3435}
3436static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3437{
3438  int sw = (int)(long)v->Data();
3439  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3440  poly p = (poly)u->CopyD(POLY_CMD);
3441  if (sw & SIMPL_NORM)
3442  {
3443    pNorm(p);
3444  }
3445  res->data = (char * )p;
3446  return FALSE;
3447}
3448static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3449{
3450  ideal result;
3451  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3452  tHomog hom=testHomog;
3453  ideal u_id=(ideal)(u->Data());
3454  if (w!=NULL)
3455  {
3456    if (!idTestHomModule(u_id,currRing->qideal,w))
3457    {
3458      WarnS("wrong weights:");w->show();PrintLn();
3459      w=NULL;
3460    }
3461    else
3462    {
3463      w=ivCopy(w);
3464      hom=isHomog;
3465    }
3466  }
3467  result=kStd(u_id,currRing->qideal,hom,&w,(intvec *)v->Data());
3468  idSkipZeroes(result);
3469  res->data = (char *)result;
3470  setFlag(res,FLAG_STD);
3471  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3472  return FALSE;
3473}
3474static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3475static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3476/* destroys i0, p0 */
3477/* result (with attributes) in res */
3478/* i0: SB*/
3479/* t0: type of p0*/
3480/* p0 new elements*/
3481/* a attributes of i0*/
3482{
3483  int tp;
3484  if (t0==IDEAL_CMD) tp=POLY_CMD;
3485  else               tp=VECTOR_CMD;
3486  for (int i=IDELEMS(p0)-1; i>=0; i--)
3487  {
3488    poly p=p0->m[i];
3489    p0->m[i]=NULL;
3490    if (p!=NULL)
3491    {
3492      sleftv u0,v0;
3493      memset(&u0,0,sizeof(sleftv));
3494      memset(&v0,0,sizeof(sleftv));
3495      v0.rtyp=tp;
3496      v0.data=(void*)p;
3497      u0.rtyp=t0;
3498      u0.data=i0;
3499      u0.attribute=a;
3500      setFlag(&u0,FLAG_STD);
3501      jjSTD_1(res,&u0,&v0);
3502      i0=(ideal)res->data;
3503      res->data=NULL;
3504      a=res->attribute;
3505      res->attribute=NULL;
3506      u0.CleanUp();
3507      v0.CleanUp();
3508      res->CleanUp();
3509    }
3510  }
3511  idDelete(&p0);
3512  res->attribute=a;
3513  res->data=(void *)i0;
3514  res->rtyp=t0;
3515}
3516static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3517{
3518  ideal result;
3519  assumeStdFlag(u);
3520  ideal i1=(ideal)(u->Data());
3521  ideal i0;
3522  int r=v->Typ();
3523  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3524  {
3525    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3526    i0->m[0]=(poly)v->Data();
3527    int ii0=idElem(i0); /* size of i0 */
3528    i1=idSimpleAdd(i1,i0); //
3529    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3530    idDelete(&i0);
3531    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3532    tHomog hom=testHomog;
3533
3534    if (w!=NULL)
3535    {
3536      if (!idTestHomModule(i1,currRing->qideal,w))
3537      {
3538        // no warnung: this is legal, if i in std(i,p)
3539        // is homogeneous, but p not
3540        w=NULL;
3541      }
3542      else
3543      {
3544        w=ivCopy(w);
3545        hom=isHomog;
3546      }
3547    }
3548    BITSET save1;
3549    SI_SAVE_OPT1(save1);
3550    si_opt_1|=Sy_bit(OPT_SB_1);
3551    /* ii0 appears to be the position of the first element of il that
3552       does not belong to the old SB ideal */
3553    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii0);
3554    SI_RESTORE_OPT1(save1);
3555    idDelete(&i1);
3556    idSkipZeroes(result);
3557    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3558    res->data = (char *)result;
3559  }
3560  else /*IDEAL/MODULE*/
3561  {
3562    attr *aa=u->Attribute();
3563    attr a=NULL;
3564    if ((aa!=NULL)&&(*aa!=NULL)) a=(*aa)->Copy();
3565    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3566  }
3567  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3568  return FALSE;
3569}
3570static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3571{
3572  idhdl h=(idhdl)u->data;
3573  int i=(int)(long)v->Data();
3574  if ((0<i) && (i<=IDRING(h)->N))
3575    res->data=omStrDup(IDRING(h)->names[i-1]);
3576  else
3577  {
3578    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3579    return TRUE;
3580  }
3581  return FALSE;
3582}
3583static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3584{
3585// input: u: a list with links of type
3586//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3587//        v: timeout for select in milliseconds
3588//           or 0 for polling
3589// returns: ERROR (via Werror): timeout negative
3590//           -1: the read state of all links is eof
3591//            0: timeout (or polling): none ready
3592//           i>0: (at least) L[i] is ready
3593  lists Lforks = (lists)u->Data();
3594  int t = (int)(long)v->Data();
3595  if(t < 0)
3596  {
3597    WerrorS("negative timeout"); return TRUE;
3598  }
3599  int i = slStatusSsiL(Lforks, t*1000);
3600  if(i == -2) /* error */
3601  {
3602    return TRUE;
3603  }
3604  res->data = (void*)(long)i;
3605  return FALSE;
3606}
3607static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3608{
3609// input: u: a list with links of type
3610//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3611//        v: timeout for select in milliseconds
3612//           or 0 for polling
3613// returns: ERROR (via Werror): timeout negative
3614//           -1: the read state of all links is eof
3615//           0: timeout (or polling): none ready
3616//           1: all links are ready
3617//              (caution: at least one is ready, but some maybe dead)
3618  lists Lforks = (lists)u->CopyD();
3619  int timeout = 1000*(int)(long)v->Data();
3620  if(timeout < 0)
3621  {
3622    WerrorS("negative timeout"); return TRUE;
3623  }
3624  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3625  int i;
3626  int ret = -1;
3627  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3628  {
3629    i = slStatusSsiL(Lforks, timeout);
3630    if(i > 0) /* Lforks[i] is ready */
3631    {
3632      ret = 1;
3633      Lforks->m[i-1].CleanUp();
3634      Lforks->m[i-1].rtyp=DEF_CMD;
3635      Lforks->m[i-1].data=NULL;
3636      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3637    }
3638    else /* terminate the for loop */
3639    {
3640      if(i == -2) /* error */
3641      {
3642        return TRUE;
3643      }
3644      if(i == 0) /* timeout */
3645      {
3646        ret = 0;
3647      }
3648      break;
3649    }
3650  }
3651  Lforks->Clean();
3652  res->data = (void*)(long)ret;
3653  return FALSE;
3654}
3655static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3656{
3657  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3658  return FALSE;
3659}
3660#define jjWRONG2 (proc2)jjWRONG
3661#define jjWRONG3 (proc3)jjWRONG
3662static BOOLEAN jjWRONG(leftv, leftv)
3663{
3664  return TRUE;
3665}
3666
3667/*=================== operations with 1 arg.: static proc =================*/
3668/* must be ordered: first operations for chars (infix ops),
3669 * then alphabetically */
3670
3671static BOOLEAN jjDUMMY(leftv res, leftv u)
3672{
3673  res->data = (char *)u->CopyD();
3674  return FALSE;
3675}
3676static BOOLEAN jjNULL(leftv, leftv)
3677{
3678  return FALSE;
3679}
3680//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3681//{
3682//  res->data = (char *)((int)(long)u->Data()+1);
3683//  return FALSE;
3684//}
3685//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3686//{
3687//  res->data = (char *)((int)(long)u->Data()-1);
3688//  return FALSE;
3689//}
3690static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3691{
3692  if (IDTYP((idhdl)u->data)==INT_CMD)
3693  {
3694    int i=IDINT((idhdl)u->data);
3695    if (iiOp==PLUSPLUS) i++;
3696    else                i--;
3697    IDDATA((idhdl)u->data)=(char *)(long)i;
3698    return FALSE;
3699  }
3700  return TRUE;
3701}
3702static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3703{
3704  number n=(number)u->CopyD(BIGINT_CMD);
3705  n=n_InpNeg(n,coeffs_BIGINT);
3706  res->data = (char *)n;
3707  return FALSE;
3708}
3709static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3710{
3711  res->data = (char *)(-(long)u->Data());
3712  return FALSE;
3713}
3714static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3715{
3716  number n=(number)u->CopyD(NUMBER_CMD);
3717  n=nInpNeg(n);
3718  res->data = (char *)n;
3719  return FALSE;
3720}
3721static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3722{
3723  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3724  return FALSE;
3725}
3726static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3727{
3728  poly m1=pISet(-1);
3729  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3730  return FALSE;
3731}
3732static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3733{
3734  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3735  (*iv)*=(-1);
3736  res->data = (char *)iv;
3737  return FALSE;
3738}
3739static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3740{
3741  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3742  (*bim)*=(-1);
3743  res->data = (char *)bim;
3744  return FALSE;
3745}
3746static BOOLEAN jjPROC1(leftv res, leftv u)
3747{
3748  return jjPROC(res,u,NULL);
3749}
3750static BOOLEAN jjBAREISS(leftv res, leftv v)
3751{
3752  //matrix m=(matrix)v->Data();
3753  //lists l=mpBareiss(m,FALSE);
3754  intvec *iv;
3755  ideal m;
3756  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3757  lists l=(lists)omAllocBin(slists_bin);
3758  l->Init(2);
3759  l->m[0].rtyp=MODUL_CMD;
3760  l->m[1].rtyp=INTVEC_CMD;
3761  l->m[0].data=(void *)m;
3762  l->m[1].data=(void *)iv;
3763  res->data = (char *)l;
3764  return FALSE;
3765}
3766//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3767//{
3768//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3769//  ivTriangMat(m);
3770//  res->data = (char *)m;
3771//  return FALSE;
3772//}
3773static BOOLEAN jjBI2N(leftv res, leftv u)
3774{
3775  BOOLEAN bo=FALSE;
3776  number n=(number)u->CopyD();
3777  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3778  if (nMap!=NULL)
3779    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3780  else
3781  {
3782    Werror("cannot convert bigint to cring %s", nCoeffString(currRing->cf));
3783    bo=TRUE;
3784  }
3785  n_Delete(&n,coeffs_BIGINT);
3786  return bo;
3787}
3788static BOOLEAN jjBI2P(leftv res, leftv u)
3789{
3790  sleftv tmp;
3791  BOOLEAN bo=jjBI2N(&tmp,u);
3792  if (!bo)
3793  {
3794    number n=(number) tmp.data;
3795    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3796    else
3797    {
3798      res->data=(void *)pNSet(n);
3799    }
3800  }
3801  return bo;
3802}
3803static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3804{
3805  return iiExprArithM(res,u,iiOp);
3806}
3807static BOOLEAN jjCHAR(leftv res, leftv v)
3808{
3809  res->data = (char *)(long)rChar((ring)v->Data());
3810  return FALSE;
3811}
3812static BOOLEAN jjCOLS(leftv res, leftv v)
3813{
3814  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3815  return FALSE;
3816}
3817static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3818{
3819  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3820  return FALSE;
3821}
3822static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3823{
3824  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3825  return FALSE;
3826}
3827static BOOLEAN jjCONTENT(leftv res, leftv v)
3828{
3829  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3830  poly p=(poly)v->CopyD(POLY_CMD);
3831  if (p!=NULL) p_Cleardenom(p, currRing);
3832  res->data = (char *)p;
3833  return FALSE;
3834}
3835static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3836{
3837  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3838  return FALSE;
3839}
3840static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3841{
3842  res->data = (char *)(long)nSize((number)v->Data());
3843  return FALSE;
3844}
3845static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3846{
3847  lists l=(lists)v->Data();
3848  res->data = (char *)(long)(lSize(l)+1);
3849  return FALSE;
3850}
3851static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3852{
3853  matrix m=(matrix)v->Data();
3854  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3855  return FALSE;
3856}
3857static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3858{
3859  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3860  return FALSE;
3861}
3862static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3863{
3864  ring r=(ring)v->Data();
3865  int elems=-1;
3866  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3867  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3868  {
3869    extern int ipower ( int b, int n ); /* factory/cf_util */
3870    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3871  }
3872  res->data = (char *)(long)elems;
3873  return FALSE;
3874}
3875static BOOLEAN jjDEG(leftv res, leftv v)
3876{
3877  int dummy;
3878  poly p=(poly)v->Data();
3879  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3880  else res->data=(char *)-1;
3881  return FALSE;
3882}
3883static BOOLEAN jjDEG_M(leftv res, leftv u)
3884{
3885  ideal I=(ideal)u->Data();
3886  int d=-1;
3887  int dummy;
3888  int i;
3889  for(i=IDELEMS(I)-1;i>=0;i--)
3890    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3891  res->data = (char *)(long)d;
3892  return FALSE;
3893}
3894static BOOLEAN jjDEGREE(leftv res, leftv v)
3895{
3896  SPrintStart();
3897#ifdef HAVE_RINGS
3898  if (rField_is_Ring_Z(currRing))
3899  {
3900    ring origR = currRing;
3901    ring tempR = rCopy(origR);
3902    coeffs new_cf=nInitChar(n_Q,NULL);
3903    nKillChar(tempR->cf);
3904    tempR->cf=new_cf;
3905    rComplete(tempR);
3906    ideal vid = (ideal)v->Data();
3907    rChangeCurrRing(tempR);
3908    ideal vv = idrCopyR(vid, origR, currRing);
3909    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3910    vvAsLeftv.rtyp = IDEAL_CMD;
3911    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3912    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3913    assumeStdFlag(&vvAsLeftv);
3914    Print("// NOTE: computation of degree is being performed for\n");
3915    Print("//       generic fibre, that is, over Q\n");
3916    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3917    scDegree(vv,module_w,currRing->qideal);
3918    idDelete(&vv);
3919    rChangeCurrRing(origR);
3920    rDelete(tempR);
3921  }
3922#endif
3923  assumeStdFlag(v);
3924  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3925  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3926  char *s=SPrintEnd();
3927  int l=strlen(s)-1;
3928  s[l]='\0';
3929  res->data=(void*)s;
3930  return FALSE;
3931}
3932static BOOLEAN jjDEFINED(leftv res, leftv v)
3933{
3934  if ((v->rtyp==IDHDL)
3935  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3936  {
3937    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3938  }
3939  else if (v->rtyp!=0) res->data=(void *)(-1);
3940  return FALSE;
3941}
3942
3943/// Return the denominator of the input number
3944/// NOTE: the input number is normalized as a side effect
3945static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3946{
3947  number n = reinterpret_cast<number>(v->Data());
3948  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3949  return FALSE;
3950}
3951
3952/// Return the numerator of the input number
3953/// NOTE: the input number is normalized as a side effect
3954static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3955{
3956  number n = reinterpret_cast<number>(v->Data());
3957  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3958  return FALSE;
3959}
3960
3961static BOOLEAN jjDET(leftv res, leftv v)
3962{
3963  matrix m=(matrix)v->Data();
3964  poly p;
3965  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3966  {
3967    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3968    p=sm_CallDet(I, currRing);
3969    idDelete(&I);
3970  }
3971  else
3972    p=singclap_det(m,currRing);
3973  res ->data = (char *)p;
3974  return FALSE;
3975}
3976static BOOLEAN jjDET_BI(leftv res, leftv v)
3977{
3978  bigintmat * m=(bigintmat*)v->Data();
3979  int i,j;
3980  i=m->rows();j=m->cols();
3981  if(i==j)
3982    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3983  else
3984  {
3985    Werror("det of %d x %d bigintmat",i,j);
3986    return TRUE;
3987  }
3988  return FALSE;
3989}
3990static BOOLEAN jjDET_I(leftv res, leftv v)
3991{
3992  intvec * m=(intvec*)v->Data();
3993  int i,j;
3994  i=m->rows();j=m->cols();
3995  if(i==j)
3996    res->data = (char *)(long)singclap_det_i(m,currRing);
3997  else
3998  {
3999    Werror("det of %d x %d intmat",i,j);
4000    return TRUE;
4001  }
4002  return FALSE;
4003}
4004static BOOLEAN jjDET_S(leftv res, leftv v)
4005{
4006  ideal I=(ideal)v->Data();
4007  poly p;
4008  if (IDELEMS(I)<1) return TRUE;
4009  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
4010  {
4011    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
4012    p=singclap_det(m,currRing);
4013    idDelete((ideal *)&m);
4014  }
4015  else
4016    p=sm_CallDet(I, currRing);
4017  res->data = (char *)p;
4018  return FALSE;
4019}
4020static BOOLEAN jjDIM(leftv res, leftv v)
4021{
4022  assumeStdFlag(v);
4023#ifdef HAVE_RINGS
4024  if (rField_is_Ring(currRing))
4025  {
4026    //ring origR = currRing;
4027    //ring tempR = rCopy(origR);
4028    //coeffs new_cf=nInitChar(n_Q,NULL);
4029    //nKillChar(tempR->cf);
4030    //tempR->cf=new_cf;
4031    //rComplete(tempR);
4032    ideal vid = (ideal)v->Data();
4033    int i = idPosConstant(vid);
4034    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4035    { /* ideal v contains unit; dim = -1 */
4036      res->data = (char *)-1;
4037      return FALSE;
4038    }
4039    //rChangeCurrRing(tempR);
4040    //ideal vv = idrCopyR(vid, origR, currRing);
4041    ideal vv = id_Head(vid,currRing);
4042    /* drop degree zero generator from vv (if any) */
4043    if (i != -1) pDelete(&vv->m[i]);
4044    long d = (long)scDimInt(vv, currRing->qideal);
4045    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
4046    res->data = (char *)d;
4047    idDelete(&vv);
4048    //rChangeCurrRing(origR);
4049    //rDelete(tempR);
4050    return FALSE;
4051  }
4052#endif
4053  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4054  return FALSE;
4055}
4056static BOOLEAN jjDUMP(leftv, leftv v)
4057{
4058  si_link l = (si_link)v->Data();
4059  if (slDump(l))
4060  {
4061    const char *s;
4062    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4063    else                            s=sNoName;
4064    Werror("cannot dump to `%s`",s);
4065    return TRUE;
4066  }
4067  else
4068    return FALSE;
4069}
4070static BOOLEAN jjE(leftv res, leftv v)
4071{
4072  res->data = (char *)pOne();
4073  int co=(int)(long)v->Data();
4074  if (co>0)
4075  {
4076    pSetComp((poly)res->data,co);
4077    pSetm((poly)res->data);
4078  }
4079  else WerrorS("argument of gen must be positive");
4080  return (co<=0);
4081}
4082static BOOLEAN jjEXECUTE(leftv, leftv v)
4083{
4084  char * d = (char *)v->Data();
4085  char * s = (char *)omAlloc(strlen(d) + 13);
4086  strcpy( s, (char *)d);
4087  strcat( s, "\n;RETURN();\n");
4088  newBuffer(s,BT_execute);
4089  return yyparse();
4090}
4091static BOOLEAN jjFACSTD(leftv res, leftv v)
4092{
4093  lists L=(lists)omAllocBin(slists_bin);
4094  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4095  {
4096    ideal_list p,h;
4097    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4098    if (h==NULL)
4099    {
4100      L->Init(1);
4101      L->m[0].data=(char *)idInit(1);
4102      L->m[0].rtyp=IDEAL_CMD;
4103    }
4104    else
4105    {
4106      p=h;
4107      int l=0;
4108      while (p!=NULL) { p=p->next;l++; }
4109      L->Init(l);
4110      l=0;
4111      while(h!=NULL)
4112      {
4113        L->m[l].data=(char *)h->d;
4114        L->m[l].rtyp=IDEAL_CMD;
4115        p=h->next;
4116        omFreeSize(h,sizeof(*h));
4117        h=p;
4118        l++;
4119      }
4120    }
4121  }
4122  else
4123  {
4124    WarnS("no factorization implemented");
4125    L->Init(1);
4126    iiExprArith1(&(L->m[0]),v,STD_CMD);
4127  }
4128  res->data=(void *)L;
4129  return FALSE;
4130}
4131static BOOLEAN jjFAC_P(leftv res, leftv u)
4132{
4133  intvec *v=NULL;
4134  singclap_factorize_retry=0;
4135  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4136  if (f==NULL) return TRUE;
4137  ivTest(v);
4138  lists l=(lists)omAllocBin(slists_bin);
4139  l->Init(2);
4140  l->m[0].rtyp=IDEAL_CMD;
4141  l->m[0].data=(void *)f;
4142  l->m[1].rtyp=INTVEC_CMD;
4143  l->m[1].data=(void *)v;
4144  res->data=(void *)l;
4145  return FALSE;
4146}
4147static BOOLEAN jjGETDUMP(leftv, leftv v)
4148{
4149  si_link l = (si_link)v->Data();
4150  if (slGetDump(l))
4151  {
4152    const char *s;
4153    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4154    else                            s=sNoName;
4155    Werror("cannot get dump from `%s`",s);
4156    return TRUE;
4157  }
4158  else
4159    return FALSE;
4160}
4161static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4162{
4163  assumeStdFlag(v);
4164  ideal I=(ideal)v->Data();
4165  res->data=(void *)iiHighCorner(I,0);
4166  return FALSE;
4167}
4168static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4169{
4170  assumeStdFlag(v);
4171  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4172  BOOLEAN delete_w=FALSE;
4173  ideal I=(ideal)v->Data();
4174  int i;
4175  poly p=NULL,po=NULL;
4176  int rk=id_RankFreeModule(I,currRing);
4177  if (w==NULL)
4178  {
4179    w = new intvec(rk);
4180    delete_w=TRUE;
4181  }
4182  for(i=rk;i>0;i--)
4183  {
4184    p=iiHighCorner(I,i);
4185    if (p==NULL)
4186    {
4187      WerrorS("module must be zero-dimensional");
4188      if (delete_w) delete w;
4189      return TRUE;
4190    }
4191    if (po==NULL)
4192    {
4193      po=p;
4194    }
4195    else
4196    {
4197      // now po!=NULL, p!=NULL
4198      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4199      if (d==0)
4200        d=pLmCmp(po,p);
4201      if (d > 0)
4202      {
4203        pDelete(&p);
4204      }
4205      else // (d < 0)
4206      {
4207        pDelete(&po); po=p;
4208      }
4209    }
4210  }
4211  if (delete_w) delete w;
4212  res->data=(void *)po;
4213  return FALSE;
4214}
4215static BOOLEAN jjHILBERT(leftv, leftv v)
4216{
4217#ifdef HAVE_RINGS
4218  if (rField_is_Ring_Z(currRing))
4219  {
4220    ring origR = currRing;
4221    ring tempR = rCopy(origR);
4222    coeffs new_cf=nInitChar(n_Q,NULL);
4223    nKillChar(tempR->cf);
4224    tempR->cf=new_cf;
4225    rComplete(tempR);
4226    ideal vid = (ideal)v->Data();
4227    rChangeCurrRing(tempR);
4228    ideal vv = idrCopyR(vid, origR, currRing);
4229    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4230    vvAsLeftv.rtyp = IDEAL_CMD;
4231    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4232    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4233    assumeStdFlag(&vvAsLeftv);
4234    Print("// NOTE: computation of Hilbert series etc. is being\n");
4235    Print("//       performed for generic fibre, that is, over Q\n");
4236    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4237    //scHilbertPoly(vv,currRing->qideal);
4238    hLookSeries(vv,module_w,currRing->qideal);
4239    idDelete(&vv);
4240    rChangeCurrRing(origR);
4241    rDelete(tempR);
4242    return FALSE;
4243  }
4244#endif
4245  assumeStdFlag(v);
4246  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4247  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4248  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4249  return FALSE;
4250}
4251static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4252{
4253#ifdef HAVE_RINGS
4254  if (rField_is_Ring_Z(currRing))
4255  {
4256    Print("// NOTE: computation of Hilbert series etc. is being\n");
4257    Print("//       performed for generic fibre, that is, over Q\n");
4258  }
4259#endif
4260  res->data=(void *)hSecondSeries((intvec *)v->Data());
4261  return FALSE;
4262}
4263static BOOLEAN jjHOMOG1(leftv res, leftv v)
4264{
4265  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4266  ideal v_id=(ideal)v->Data();
4267  if (w==NULL)
4268  {
4269    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4270    if (res->data!=NULL)
4271    {
4272      if (v->rtyp==IDHDL)
4273      {
4274        char *s_isHomog=omStrDup("isHomog");
4275        if (v->e==NULL)
4276          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4277        else
4278          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4279      }
4280      else if (w!=NULL) delete w;
4281    } // if res->data==NULL then w==NULL
4282  }
4283  else
4284  {
4285    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4286    if((res->data==NULL) && (v->rtyp==IDHDL))
4287    {
4288      if (v->e==NULL)
4289        atKill((idhdl)(v->data),"isHomog");
4290      else
4291        atKill((idhdl)(v->LData()),"isHomog");
4292    }
4293  }
4294  return FALSE;
4295}
4296static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4297{
4298  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4299  setFlag(res,FLAG_STD);
4300  return FALSE;
4301}
4302static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4303{
4304  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4305  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4306  if (IDELEMS((ideal)mat)==0)
4307  {
4308    idDelete((ideal *)&mat);
4309    mat=(matrix)idInit(1,1);
4310  }
4311  else
4312  {
4313    MATROWS(mat)=1;
4314    mat->rank=1;
4315    idTest((ideal)mat);
4316  }
4317  res->data=(char *)mat;
4318  return FALSE;
4319}
4320static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4321{
4322  map m=(map)v->CopyD(MAP_CMD);
4323  omFree((ADDRESS)m->preimage);
4324  m->preimage=NULL;
4325  ideal I=(ideal)m;
4326  I->rank=1;
4327  res->data=(char *)I;
4328  return FALSE;
4329}
4330static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4331{
4332  if (currRing!=NULL)
4333  {
4334    ring q=(ring)v->Data();
4335    if (rSamePolyRep(currRing, q))
4336    {
4337      if (q->qideal==NULL)
4338        res->data=(char *)idInit(1,1);
4339      else
4340        res->data=(char *)idCopy(q->qideal);
4341      return FALSE;
4342    }
4343  }
4344  WerrorS("can only get ideal from identical qring");
4345  return TRUE;
4346}
4347static BOOLEAN jjIm2Iv(leftv res, leftv v)
4348{
4349  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4350  iv->makeVector();
4351  res->data = iv;
4352  return FALSE;
4353}
4354static BOOLEAN jjIMPART(leftv res, leftv v)
4355{
4356  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4357  return FALSE;
4358}
4359static BOOLEAN jjINDEPSET(leftv res, leftv v)
4360{
4361  assumeStdFlag(v);
4362  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4363  return FALSE;
4364}
4365static BOOLEAN jjINTERRED(leftv res, leftv v)
4366{
4367  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4368  #ifdef HAVE_RINGS
4369  if(rField_is_Ring(currRing))
4370    Warn("interred: this command is experimental over the integers");
4371  #endif
4372  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4373  res->data = result;
4374  return FALSE;
4375}
4376static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4377{
4378  res->data = (char *)(long)pVar((poly)v->Data());
4379  return FALSE;
4380}
4381static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4382{
4383  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4384                                                            currRing->N)+1);
4385  return FALSE;
4386}
4387static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4388{
4389  res->data = (char *)0;
4390  return FALSE;
4391}
4392static BOOLEAN jjJACOB_P(leftv res, leftv v)
4393{
4394  ideal i=idInit(currRing->N,1);
4395  int k;
4396  poly p=(poly)(v->Data());
4397  for (k=currRing->N;k>0;k--)
4398  {
4399    i->m[k-1]=pDiff(p,k);
4400  }
4401  res->data = (char *)i;
4402  return FALSE;
4403}
4404static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4405{
4406  if (!nCoeff_is_transExt(currRing->cf))
4407  {
4408    WerrorS("differentiation not defined in the coefficient ring");
4409    return TRUE;
4410  }
4411  number n = (number) u->Data();
4412  number k = (number) v->Data();
4413  res->data = ntDiff(n,k,currRing->cf);
4414  return FALSE;
4415}
4416/*2
4417 * compute Jacobi matrix of a module/matrix
4418 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4419 * where Mt := transpose(M)
4420 * Note that this is consistent with the current conventions for jacob in Singular,
4421 * whereas M2 computes its transposed.
4422 */
4423static BOOLEAN jjJACOB_M(leftv res, leftv a)
4424{
4425  ideal id = (ideal)a->Data();
4426  id = idTransp(id);
4427  int W = IDELEMS(id);
4428
4429  ideal result = idInit(W * currRing->N, id->rank);
4430  poly *p = result->m;
4431
4432  for( int v = 1; v <= currRing->N; v++ )
4433  {
4434    poly* q = id->m;
4435    for( int i = 0; i < W; i++, p++, q++ )
4436      *p = pDiff( *q, v );
4437  }
4438  idDelete(&id);
4439
4440  res->data = (char *)result;
4441  return FALSE;
4442}
4443
4444
4445static BOOLEAN jjKBASE(leftv res, leftv v)
4446{
4447  assumeStdFlag(v);
4448  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4449  return FALSE;
4450}
4451static BOOLEAN jjL2R(leftv res, leftv v)
4452{
4453  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4454  if (res->data != NULL)
4455    return FALSE;
4456  else
4457    return TRUE;
4458}
4459static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4460{
4461  poly p=(poly)v->Data();
4462  if (p==NULL)
4463  {
4464    res->data=(char *)nInit(0);
4465  }
4466  else
4467  {
4468    res->data=(char *)nCopy(pGetCoeff(p));
4469  }
4470  return FALSE;
4471}
4472static BOOLEAN jjLEADEXP(leftv res, leftv v)
4473{
4474  poly p=(poly)v->Data();
4475  int s=currRing->N;
4476  if (v->Typ()==VECTOR_CMD) s++;
4477  intvec *iv=new intvec(s);
4478  if (p!=NULL)
4479  {
4480    for(int i = currRing->N;i;i--)
4481    {
4482      (*iv)[i-1]=pGetExp(p,i);
4483    }
4484    if (s!=currRing->N)
4485      (*iv)[currRing->N]=pGetComp(p);
4486  }
4487  res->data=(char *)iv;
4488  return FALSE;
4489}
4490static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4491{
4492  poly p=(poly)v->Data();
4493  if (p == NULL)
4494  {
4495    res->data = (char*) NULL;
4496  }
4497  else
4498  {
4499    poly lm = pLmInit(p);
4500    pSetCoeff(lm, nInit(1));
4501    res->data = (char*) lm;
4502  }
4503  return FALSE;
4504}
4505static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4506{
4507  return jjLOAD((char*)v->Data(),FALSE);
4508}
4509static BOOLEAN jjLISTRING(leftv res, leftv v)
4510{
4511  ring r=rCompose((lists)v->Data());
4512  if (r==NULL) return TRUE;
4513  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4514  res->data=(char *)r;
4515  return FALSE;
4516}
4517static BOOLEAN jjPFAC1(leftv res, leftv v)
4518{
4519  /* call method jjPFAC2 with second argument = 0 (meaning that no
4520     valid bound for the prime factors has been given) */
4521  sleftv tmp;
4522  memset(&tmp, 0, sizeof(tmp));
4523  tmp.rtyp = INT_CMD;
4524  return jjPFAC2(res, v, &tmp);
4525}
4526static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4527{
4528  /* computes the LU-decomposition of a matrix M;
4529     i.e., M = P * L * U, where
4530        - P is a row permutation matrix,
4531        - L is in lower triangular form,
4532        - U is in upper row echelon form
4533     Then, we also have P * M = L * U.
4534     A list [P, L, U] is returned. */
4535  matrix mat = (const matrix)v->Data();
4536  if (!idIsConstant((ideal)mat))
4537  {
4538    WerrorS("matrix must be constant");
4539    return TRUE;
4540  }
4541  matrix pMat;
4542  matrix lMat;
4543  matrix uMat;
4544
4545  luDecomp(mat, pMat, lMat, uMat);
4546
4547  lists ll = (lists)omAllocBin(slists_bin);
4548  ll->Init(3);
4549  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4550  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4551  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4552  res->data=(char*)ll;
4553
4554  return FALSE;
4555}
4556static BOOLEAN jjMEMORY(leftv res, leftv v)
4557{
4558  omUpdateInfo();
4559  switch(((int)(long)v->Data()))
4560  {
4561  case 0:
4562    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4563    break;
4564  case 1:
4565    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4566    break;
4567  case 2:
4568    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4569    break;
4570  default:
4571    omPrintStats(stdout);
4572    omPrintInfo(stdout);
4573    omPrintBinStats(stdout);
4574    res->data = (char *)0;
4575    res->rtyp = NONE;
4576  }
4577  return FALSE;
4578  res->data = (char *)0;
4579  return FALSE;
4580}
4581//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4582//{
4583//  return jjMONITOR2(res,v,NULL);
4584//}
4585static BOOLEAN jjMSTD(leftv res, leftv v)
4586{
4587  int t=v->Typ();
4588  ideal r,m;
4589  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4590  lists l=(lists)omAllocBin(slists_bin);
4591  l->Init(2);
4592  l->m[0].rtyp=t;
4593  l->m[0].data=(char *)r;
4594  setFlag(&(l->m[0]),FLAG_STD);
4595  l->m[1].rtyp=t;
4596  l->m[1].data=(char *)m;
4597  res->data=(char *)l;
4598  return FALSE;
4599}
4600static BOOLEAN jjMULT(leftv res, leftv v)
4601{
4602  assumeStdFlag(v);
4603  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4604  return FALSE;
4605}
4606static BOOLEAN jjMINRES_R(leftv res, leftv v)
4607{
4608  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4609
4610  syStrategy tmp=(syStrategy)v->Data();
4611  tmp = syMinimize(tmp); // enrich itself!
4612
4613  res->data=(char *)tmp;
4614
4615  if (weights!=NULL)
4616    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4617
4618  return FALSE;
4619}
4620static BOOLEAN jjN2BI(leftv res, leftv v)
4621{
4622  number n,i; i=(number)v->Data();
4623  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4624  if (nMap!=NULL)
4625    n=nMap(i,currRing->cf,coeffs_BIGINT);
4626  else goto err;
4627  res->data=(void *)n;
4628  return FALSE;
4629err:
4630  WerrorS("cannot convert to bigint"); return TRUE;
4631}
4632static BOOLEAN jjNAMEOF(leftv res, leftv v)
4633{
4634  res->data = (char *)v->name;
4635  if (res->data==NULL) res->data=omStrDup("");
4636  v->name=NULL;
4637  return FALSE;
4638}
4639static BOOLEAN jjNAMES(leftv res, leftv v)
4640{
4641  res->data=ipNameList(((ring)v->Data())->idroot);
4642  return FALSE;
4643}
4644static BOOLEAN jjNAMES_I(leftv res, leftv v)
4645{
4646  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4647  return FALSE;
4648}
4649static BOOLEAN jjNOT(leftv res, leftv v)
4650{
4651  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4652  return FALSE;
4653}
4654static BOOLEAN jjNVARS(leftv res, leftv v)
4655{
4656  res->data = (char *)(long)(((ring)(v->Data()))->N);
4657  return FALSE;
4658}
4659static BOOLEAN jjOpenClose(leftv, leftv v)
4660{
4661  si_link l=(si_link)v->Data();
4662  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4663  else                return slClose(l);
4664}
4665static BOOLEAN jjORD(leftv res, leftv v)
4666{
4667  poly p=(poly)v->Data();
4668  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4669  return FALSE;
4670}
4671static BOOLEAN jjPAR1(leftv res, leftv v)
4672{
4673  int i=(int)(long)v->Data();
4674  int p=0;
4675  p=rPar(currRing);
4676  if ((0<i) && (i<=p))
4677  {
4678    res->data=(char *)n_Param(i,currRing);
4679  }
4680  else
4681  {
4682    Werror("par number %d out of range 1..%d",i,p);
4683    return TRUE;
4684  }
4685  return FALSE;
4686}
4687static BOOLEAN jjPARDEG(leftv res, leftv v)
4688{
4689  number nn=(number)v->Data();
4690  res->data = (char *)(long)n_ParDeg(nn, currRing);
4691  return FALSE;
4692}
4693static BOOLEAN jjPARSTR1(leftv res, leftv v)
4694{
4695  if (currRing==NULL)
4696  {
4697    WerrorS("no ring active");
4698    return TRUE;
4699  }
4700  int i=(int)(long)v->Data();
4701  int p=0;
4702  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4703    res->data=omStrDup(rParameter(currRing)[i-1]);
4704  else
4705  {
4706    Werror("par number %d out of range 1..%d",i,p);
4707    return TRUE;
4708  }
4709  return FALSE;
4710}
4711static BOOLEAN jjP2BI(leftv res, leftv v)
4712{
4713  poly p=(poly)v->Data();
4714  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4715  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4716  {
4717    WerrorS("poly must be constant");
4718    return TRUE;
4719  }
4720  number i=pGetCoeff(p);
4721  number n;
4722  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4723  if (nMap!=NULL)
4724    n=nMap(i,currRing->cf,coeffs_BIGINT);
4725  else goto err;
4726  res->data=(void *)n;
4727  return FALSE;
4728err:
4729  WerrorS("cannot convert to bigint"); return TRUE;
4730}
4731static BOOLEAN jjP2I(leftv res, leftv v)
4732{
4733  poly p=(poly)v->Data();
4734  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4735  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4736  {
4737    WerrorS("poly must be constant");
4738    return TRUE;
4739  }
4740  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4741  return FALSE;
4742}
4743static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4744{
4745  map mapping=(map)v->Data();
4746  syMake(res,omStrDup(mapping->preimage));
4747  return FALSE;
4748}
4749static BOOLEAN jjPRIME(leftv res, leftv v)
4750{
4751  int i = IsPrime((int)(long)(v->Data()));
4752  res->data = (char *)(long)(i > 1 ? i : 2);
4753  return FALSE;
4754}
4755static BOOLEAN jjPRUNE(leftv res, leftv v)
4756{
4757  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4758  ideal v_id=(ideal)v->Data();
4759  if (w!=NULL)
4760  {
4761    if (!idTestHomModule(v_id,currRing->qideal,w))
4762    {
4763      WarnS("wrong weights");
4764      w=NULL;
4765      // and continue at the non-homog case below
4766    }
4767    else
4768    {
4769      w=ivCopy(w);
4770      intvec **ww=&w;
4771      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4772      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4773      return FALSE;
4774    }
4775  }
4776  res->data = (char *)idMinEmbedding(v_id);
4777  return FALSE;
4778}
4779static BOOLEAN jjP2N(leftv res, leftv v)
4780{
4781  number n;
4782  poly p;
4783  if (((p=(poly)v->Data())!=NULL)
4784  && (pIsConstant(p)))
4785  {
4786    n=nCopy(pGetCoeff(p));
4787  }
4788  else
4789  {
4790    n=nInit(0);
4791  }
4792  res->data = (char *)n;
4793  return FALSE;
4794}
4795static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4796{
4797  char *s= (char *)v->Data();
4798  int i = 1;
4799  for(i=0; i<sArithBase.nCmdUsed; i++)
4800  {
4801    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4802    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4803    {
4804      res->data = (char *)1;
4805      return FALSE;
4806    }
4807  }
4808  //res->data = (char *)0;
4809  return FALSE;
4810}
4811static BOOLEAN jjRANK1(leftv res, leftv v)
4812{
4813  matrix m =(matrix)v->Data();
4814  int rank = luRank(m, 0);
4815  res->data =(char *)(long)rank;
4816  return FALSE;
4817}
4818static BOOLEAN jjREAD(leftv res, leftv v)
4819{
4820  return jjREAD2(res,v,NULL);
4821}
4822static BOOLEAN jjREGULARITY(leftv res, leftv v)
4823{
4824  res->data = (char *)(long)iiRegularity((lists)v->Data());
4825  return FALSE;
4826}
4827static BOOLEAN jjREPART(leftv res, leftv v)
4828{
4829  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4830  return FALSE;
4831}
4832static BOOLEAN jjRINGLIST(leftv res, leftv v)
4833{
4834  ring r=(ring)v->Data();
4835  if (r!=NULL)
4836    res->data = (char *)rDecompose((ring)v->Data());
4837  return (r==NULL)||(res->data==NULL);
4838}
4839static BOOLEAN jjROWS(leftv res, leftv v)
4840{
4841  ideal i = (ideal)v->Data();
4842  res->data = (char *)i->rank;
4843  return FALSE;
4844}
4845static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4846{
4847  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4848  return FALSE;
4849}
4850static BOOLEAN jjROWS_IV(leftv res, leftv v)
4851{
4852  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4853  return FALSE;
4854}
4855static BOOLEAN jjRPAR(leftv res, leftv v)
4856{
4857  res->data = (char *)(long)rPar(((ring)v->Data()));
4858  return FALSE;
4859}
4860static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4861{
4862#ifdef HAVE_PLURAL
4863  const bool bIsSCA = rIsSCA(currRing);
4864#else
4865  const bool bIsSCA = false;
4866#endif
4867
4868  if ((currRing->qideal!=NULL) && !bIsSCA)
4869  {
4870    WerrorS("qring not supported by slimgb at the moment");
4871    return TRUE;
4872  }
4873  if (rHasLocalOrMixedOrdering_currRing())
4874  {
4875    WerrorS("ordering must be global for slimgb");
4876    return TRUE;
4877  }
4878  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4879  // tHomog hom=testHomog;
4880  ideal u_id=(ideal)u->Data();
4881  if (w!=NULL)
4882  {
4883    if (!idTestHomModule(u_id,currRing->qideal,w))
4884    {
4885      WarnS("wrong weights");
4886      w=NULL;
4887    }
4888    else
4889    {
4890      w=ivCopy(w);
4891      // hom=isHomog;
4892    }
4893  }
4894
4895  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4896  res->data=(char *)t_rep_gb(currRing,
4897    u_id,u_id->rank);
4898  //res->data=(char *)t_rep_gb(currRing, u_id);
4899
4900  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4901  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4902  return FALSE;
4903}
4904static BOOLEAN jjSBA(leftv res, leftv v)
4905{
4906  ideal result;
4907  ideal v_id=(ideal)v->Data();
4908  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4909  tHomog hom=testHomog;
4910  if (w!=NULL)
4911  {
4912    if (!idTestHomModule(v_id,currRing->qideal,w))
4913    {
4914      WarnS("wrong weights");
4915      w=NULL;
4916    }
4917    else
4918    {
4919      hom=isHomog;
4920      w=ivCopy(w);
4921    }
4922  }
4923  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4924  idSkipZeroes(result);
4925  res->data = (char *)result;
4926  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4927  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4928  return FALSE;
4929}
4930static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4931{
4932  ideal result;
4933  ideal v_id=(ideal)v->Data();
4934  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4935  tHomog hom=testHomog;
4936  if (w!=NULL)
4937  {
4938    if (!idTestHomModule(v_id,currRing->qideal,w))
4939    {
4940      WarnS("wrong weights");
4941      w=NULL;
4942    }
4943    else
4944    {
4945      hom=isHomog;
4946      w=ivCopy(w);
4947    }
4948  }
4949  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4950  idSkipZeroes(result);
4951  res->data = (char *)result;
4952  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4953  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4954  return FALSE;
4955}
4956static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4957{
4958  ideal result;
4959  ideal v_id=(ideal)v->Data();
4960  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4961  tHomog hom=testHomog;
4962  if (w!=NULL)
4963  {
4964    if (!idTestHomModule(v_id,currRing->qideal,w))
4965    {
4966      WarnS("wrong weights");
4967      w=NULL;
4968    }
4969    else
4970    {
4971      hom=isHomog;
4972      w=ivCopy(w);
4973    }
4974  }
4975  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4976  idSkipZeroes(result);
4977  res->data = (char *)result;
4978  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4979  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4980  return FALSE;
4981}
4982static BOOLEAN jjSTD(leftv res, leftv v)
4983{
4984  ideal result;
4985  ideal v_id=(ideal)v->Data();
4986  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4987  tHomog hom=testHomog;
4988  if (w!=NULL)
4989  {
4990    if (!idTestHomModule(v_id,currRing->qideal,w))
4991    {
4992      WarnS("wrong weights");
4993      w=NULL;
4994    }
4995    else
4996    {
4997      hom=isHomog;
4998      w=ivCopy(w);
4999    }
5000  }
5001  result=kStd(v_id,currRing->qideal,hom,&w);
5002  idSkipZeroes(result);
5003  res->data = (char *)result;
5004  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5005  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5006  return FALSE;
5007}
5008static BOOLEAN jjSort_Id(leftv res, leftv v)
5009{
5010  res->data = (char *)idSort((ideal)v->Data());
5011  return FALSE;
5012}
5013static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5014{
5015  singclap_factorize_retry=0;
5016  intvec *v=NULL;
5017  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5018  if (f==NULL) return TRUE;
5019  ivTest(v);
5020  lists l=(lists)omAllocBin(slists_bin);
5021  l->Init(2);
5022  l->m[0].rtyp=IDEAL_CMD;
5023  l->m[0].data=(void *)f;
5024  l->m[1].rtyp=INTVEC_CMD;
5025  l->m[1].data=(void *)v;
5026  res->data=(void *)l;
5027  return FALSE;
5028}
5029#if 1
5030static BOOLEAN jjSYZYGY(leftv res, leftv v)
5031{
5032  intvec *w=NULL;
5033  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5034  if (w!=NULL) delete w;
5035  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5036  return FALSE;
5037}
5038#else
5039// activate, if idSyz handle module weights correctly !
5040static BOOLEAN jjSYZYGY(leftv res, leftv v)
5041{
5042  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5043  ideal v_id=(ideal)v->Data();
5044  tHomog hom=testHomog;
5045  int add_row_shift=0;
5046  if (w!=NULL)
5047  {
5048    w=ivCopy(w);
5049    add_row_shift=w->min_in();
5050    (*w)-=add_row_shift;
5051    if (idTestHomModule(v_id,currRing->qideal,w))
5052      hom=isHomog;
5053    else
5054    {
5055      //WarnS("wrong weights");
5056      delete w; w=NULL;
5057      hom=testHomog;
5058    }
5059  }
5060  res->data = (char *)idSyzygies(v_id,hom,&w);
5061  if (w!=NULL)
5062  {
5063    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5064  }
5065  return FALSE;
5066}
5067#endif
5068static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5069{
5070  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5071  return FALSE;
5072}
5073static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5074{
5075  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5076  return FALSE;
5077}
5078static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5079{
5080  res->data = (char *)ivTranp((intvec*)(v->Data()));
5081  return FALSE;
5082}
5083#ifdef HAVE_PLURAL
5084static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5085{
5086  ring    r = (ring)a->Data();
5087  //if (rIsPluralRing(r))
5088  if (r->OrdSgn==1)
5089  {
5090    res->data = rOpposite(r);
5091  }
5092  else
5093  {
5094    WarnS("opposite only for global orderings");
5095    res->data = rCopy(r);
5096  }
5097  return FALSE;
5098}
5099static BOOLEAN jjENVELOPE(leftv res, leftv a)
5100{
5101  ring    r = (ring)a->Data();
5102  if (rIsPluralRing(r))
5103  {
5104    //    ideal   i;
5105//     if (a->rtyp == QRING_CMD)
5106//     {
5107//       i = r->qideal;
5108//       r->qideal = NULL;
5109//     }
5110    ring s = rEnvelope(r);
5111//     if (a->rtyp == QRING_CMD)
5112//     {
5113//       ideal is  = idOppose(r,i); /* twostd? */
5114//       is        = idAdd(is,i);
5115//       s->qideal = i;
5116//     }
5117    res->data = s;
5118  }
5119  else  res->data = rCopy(r);
5120  return FALSE;
5121}
5122static BOOLEAN jjTWOSTD(leftv res, leftv a)
5123{
5124  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5125  else  res->data=(ideal)a->CopyD();
5126  setFlag(res,FLAG_STD);
5127  setFlag(res,FLAG_TWOSTD);
5128  return FALSE;
5129}
5130#endif
5131
5132static BOOLEAN jjTYPEOF(leftv res, leftv v)
5133{
5134  int t=(int)(long)v->data;
5135  switch (t)
5136  {
5137    case CRING_CMD:
5138    case INT_CMD:
5139    case POLY_CMD:
5140    case VECTOR_CMD:
5141    case STRING_CMD:
5142    case INTVEC_CMD:
5143    case IDEAL_CMD:
5144    case MATRIX_CMD:
5145    case MODUL_CMD:
5146    case MAP_CMD:
5147    case PROC_CMD:
5148    case RING_CMD:
5149    case QRING_CMD:
5150    case INTMAT_CMD:
5151    case BIGINTMAT_CMD:
5152    case NUMBER_CMD:
5153    #ifdef SINGULAR_4_1
5154    case CNUMBER_CMD:
5155    #endif
5156    case BIGINT_CMD:
5157    case LIST_CMD:
5158    case PACKAGE_CMD:
5159    case LINK_CMD:
5160    case RESOLUTION_CMD:
5161         res->data=omStrDup(Tok2Cmdname(t)); break;
5162    case DEF_CMD:
5163    case NONE:           res->data=omStrDup("none"); break;
5164    default:
5165    {
5166      if (t>MAX_TOK)
5167        res->data=omStrDup(getBlackboxName(t));
5168      else
5169        res->data=omStrDup("?unknown type?");
5170      break;
5171    }
5172  }
5173  return FALSE;
5174}
5175static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5176{
5177  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5178  return FALSE;
5179}
5180static BOOLEAN jjVAR1(leftv res, leftv v)
5181{
5182  int i=(int)(long)v->Data();
5183  if ((0<i) && (i<=currRing->N))
5184  {
5185    poly p=pOne();
5186    pSetExp(p,i,1);
5187    pSetm(p);
5188    res->data=(char *)p;
5189  }
5190  else
5191  {
5192    Werror("var number %d out of range 1..%d",i,currRing->N);
5193    return TRUE;
5194  }
5195  return FALSE;
5196}
5197static BOOLEAN jjVARSTR1(leftv res, leftv v)
5198{
5199  if (currRing==NULL)
5200  {
5201    WerrorS("no ring active");
5202    return TRUE;
5203  }
5204  int i=(int)(long)v->Data();
5205  if ((0<i) && (i<=currRing->N))
5206    res->data=omStrDup(currRing->names[i-1]);
5207  else
5208  {
5209    Werror("var number %d out of range 1..%d",i,currRing->N);
5210    return TRUE;
5211  }
5212  return FALSE;
5213}
5214static BOOLEAN jjVDIM(leftv res, leftv v)
5215{
5216  assumeStdFlag(v);
5217  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5218  return FALSE;
5219}
5220BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5221{
5222// input: u: a list with links of type
5223//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5224// returns: -1:  the read state of all links is eof
5225//          i>0: (at least) u[i] is ready
5226  lists Lforks = (lists)u->Data();
5227  int i = slStatusSsiL(Lforks, -1);
5228  if(i == -2) /* error */
5229  {
5230    return TRUE;
5231  }
5232  res->data = (void*)(long)i;
5233  return FALSE;
5234}
5235BOOLEAN jjWAITALL1(leftv res, leftv u)
5236{
5237// input: u: a list with links of type
5238//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5239// returns: -1: the read state of all links is eof
5240//           1: all links are ready
5241//              (caution: at least one is ready, but some maybe dead)
5242  lists Lforks = (lists)u->CopyD();
5243  int i;
5244  int j = -1;
5245  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5246  {
5247    i = slStatusSsiL(Lforks, -1);
5248    if(i == -2) /* error */
5249    {
5250      return TRUE;
5251    }
5252    if(i == -1)
5253    {
5254      break;
5255    }
5256    j = 1;
5257    Lforks->m[i-1].CleanUp();
5258    Lforks->m[i-1].rtyp=DEF_CMD;
5259    Lforks->m[i-1].data=NULL;
5260  }
5261  res->data = (void*)(long)j;
5262  Lforks->Clean();
5263  return FALSE;
5264}
5265
5266BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5267{
5268  char libnamebuf[256];
5269  lib_types LT = type_of_LIB(s, libnamebuf);
5270
5271#ifdef HAVE_DYNAMIC_LOADING
5272  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5273#endif /* HAVE_DYNAMIC_LOADING */
5274  switch(LT)
5275  {
5276      default:
5277      case LT_NONE:
5278        Werror("%s: unknown type", s);
5279        break;
5280      case LT_NOTFOUND:
5281        Werror("cannot open %s", s);
5282        break;
5283
5284      case LT_SINGULAR:
5285      {
5286        char *plib = iiConvName(s);
5287        idhdl pl = IDROOT->get(plib,0);
5288        if (pl==NULL)
5289        {
5290          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5291          IDPACKAGE(pl)->language = LANG_SINGULAR;
5292          IDPACKAGE(pl)->libname=omStrDup(plib);
5293        }
5294        else if (IDTYP(pl)!=PACKAGE_CMD)
5295        {
5296          Werror("can not create package `%s`",plib);
5297          omFree(plib);
5298          return TRUE;
5299        }
5300        package savepack=currPack;
5301        currPack=IDPACKAGE(pl);
5302        IDPACKAGE(pl)->loaded=TRUE;
5303        char libnamebuf[256];
5304        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5305        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5306        currPack=savepack;
5307        IDPACKAGE(pl)->loaded=(!bo);
5308        return bo;
5309      }
5310      case LT_BUILTIN:
5311        SModulFunc_t iiGetBuiltinModInit(const char*);
5312        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5313      case LT_MACH_O:
5314      case LT_ELF:
5315      case LT_HPUX:
5316#ifdef HAVE_DYNAMIC_LOADING
5317        return load_modules(s, libnamebuf, autoexport);
5318#else /* HAVE_DYNAMIC_LOADING */
5319        WerrorS("Dynamic modules are not supported by this version of Singular");
5320        break;
5321#endif /* HAVE_DYNAMIC_LOADING */
5322  }
5323  return TRUE;
5324}
5325
5326static BOOLEAN jjstrlen(leftv res, leftv v)
5327{
5328  res->data = (char *)strlen((char *)v->Data());
5329  return FALSE;
5330}
5331static BOOLEAN jjpLength(leftv res, leftv v)
5332{
5333  res->data = (char *)(long)pLength((poly)v->Data());
5334  return FALSE;
5335}
5336static BOOLEAN jjidElem(leftv res, leftv v)
5337{
5338  res->data = (char *)(long)idElem((ideal)v->Data());
5339  return FALSE;
5340}
5341static BOOLEAN jjidFreeModule(leftv res, leftv v)
5342{
5343  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5344  return FALSE;
5345}
5346static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5347{
5348  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5349  return FALSE;
5350}
5351static BOOLEAN jjrCharStr(leftv res, leftv v)
5352{
5353#ifdef SINGULAR_4_1
5354  iiReWrite("charstr");
5355#endif
5356  res->data = rCharStr((ring)v->Data());
5357  return FALSE;
5358}
5359static BOOLEAN jjpHead(leftv res, leftv v)
5360{
5361  res->data = (char *)pHead((poly)v->Data());
5362  return FALSE;
5363}
5364static BOOLEAN jjidHead(leftv res, leftv v)
5365{
5366  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5367  setFlag(res,FLAG_STD);
5368  return FALSE;
5369}
5370static BOOLEAN jjidMinBase(leftv res, leftv v)
5371{
5372  res->data = (char *)idMinBase((ideal)v->Data());
5373  return FALSE;
5374}
5375static BOOLEAN jjsyMinBase(leftv res, leftv v)
5376{
5377  res->data = (char *)syMinBase((ideal)v->Data());
5378  return FALSE;
5379}
5380static BOOLEAN jjpMaxComp(leftv res, leftv v)
5381{
5382  res->data = (char *)pMaxComp((poly)v->Data());
5383  return FALSE;
5384}
5385static BOOLEAN jjmpTrace(leftv res, leftv v)
5386{
5387  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5388  return FALSE;
5389}
5390static BOOLEAN jjmpTransp(leftv res, leftv v)
5391{
5392  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5393  return FALSE;
5394}
5395static BOOLEAN jjrOrdStr(leftv res, leftv v)
5396{
5397#ifdef SINGULAR_4_1
5398  iiReWrite("ordstr");
5399#endif
5400  res->data = rOrdStr((ring)v->Data());
5401  return FALSE;
5402}
5403static BOOLEAN jjrVarStr(leftv res, leftv v)
5404{
5405#ifdef SINGULAR_4_1
5406  iiReWrite("varstr");
5407#endif
5408  res->data = rVarStr((ring)v->Data());
5409  return FALSE;
5410}
5411static BOOLEAN jjrParStr(leftv res, leftv v)
5412{
5413#ifdef SINGULAR_4_1
5414  iiReWrite("varstr");
5415#endif
5416  res->data = rParStr((ring)v->Data());
5417  return FALSE;
5418}
5419static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5420{
5421  res->data=(char *)(long)sySize((syStrategy)v->Data());
5422  return FALSE;
5423}
5424static BOOLEAN jjDIM_R(leftv res, leftv v)
5425{
5426  res->data = (char *)(long)syDim((syStrategy)v->Data());
5427  return FALSE;
5428}
5429static BOOLEAN jjidTransp(leftv res, leftv v)
5430{
5431  res->data = (char *)idTransp((ideal)v->Data());
5432  return FALSE;
5433}
5434static BOOLEAN jjnInt(leftv res, leftv u)
5435{
5436  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5437  res->data=(char *)(long)iin_Int(n,currRing->cf);
5438  n_Delete(&n,currRing->cf);
5439  return FALSE;
5440}
5441static BOOLEAN jjnlInt(leftv res, leftv u)
5442{
5443  number n=(number)u->Data();
5444  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5445  return FALSE;
5446}
5447/*=================== operations with 3 args.: static proc =================*/
5448/* must be ordered: first operations for chars (infix ops),
5449 * then alphabetically */
5450static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5451{
5452  char *s= (char *)u->Data();
5453  int   r = (int)(long)v->Data();
5454  int   c = (int)(long)w->Data();
5455  int l = strlen(s);
5456
5457  if ( (r<1) || (r>l) || (c<0) )
5458  {
5459    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5460    return TRUE;
5461  }
5462  res->data = (char *)omAlloc((long)(c+1));
5463  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5464  return FALSE;
5465}
5466static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5467{
5468  intvec *iv = (intvec *)u->Data();
5469  int   r = (int)(long)v->Data();
5470  int   c = (int)(long)w->Data();
5471  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5472  {
5473    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5474           r,c,u->Fullname(),iv->rows(),iv->cols());
5475    return TRUE;
5476  }
5477  res->data=u->data; u->data=NULL;
5478  res->rtyp=u->rtyp; u->rtyp=0;
5479  res->name=u->name; u->name=NULL;
5480  Subexpr e=jjMakeSub(v);
5481          e->next=jjMakeSub(w);
5482  if (u->e==NULL) res->e=e;
5483  else
5484  {
5485    Subexpr h=u->e;
5486    while (h->next!=NULL) h=h->next;
5487    h->next=e;
5488    res->e=u->e;
5489    u->e=NULL;
5490  }
5491  return FALSE;
5492}
5493static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5494{
5495  bigintmat *bim = (bigintmat *)u->Data();
5496  int   r = (int)(long)v->Data();
5497  int   c = (int)(long)w->Data();
5498  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5499  {
5500    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5501           r,c,u->Fullname(),bim->rows(),bim->cols());
5502    return TRUE;
5503  }
5504  res->data=u->data; u->data=NULL;
5505  res->rtyp=u->rtyp; u->rtyp=0;
5506  res->name=u->name; u->name=NULL;
5507  Subexpr e=jjMakeSub(v);
5508          e->next=jjMakeSub(w);
5509  if (u->e==NULL)
5510    res->e=e;
5511  else
5512  {
5513    Subexpr h=u->e;
5514    while (h->next!=NULL) h=h->next;
5515    h->next=e;
5516    res->e=u->e;
5517    u->e=NULL;
5518  }
5519  return FALSE;
5520}
5521static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5522{
5523  matrix m= (matrix)u->Data();
5524  int   r = (int)(long)v->Data();
5525  int   c = (int)(long)w->Data();
5526  //Print("gen. elem %d, %d\n",r,c);
5527  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5528  {
5529    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5530      MATROWS(m),MATCOLS(m));
5531    return TRUE;
5532  }
5533  res->data=u->data; u->data=NULL;
5534  res->rtyp=u->rtyp; u->rtyp=0;
5535  res->name=u->name; u->name=NULL;
5536  Subexpr e=jjMakeSub(v);
5537          e->next=jjMakeSub(w);
5538  if (u->e==NULL)
5539    res->e=e;
5540  else
5541  {
5542    Subexpr h=u->e;
5543    while (h->next!=NULL) h=h->next;
5544    h->next=e;
5545    res->e=u->e;
5546    u->e=NULL;
5547  }
5548  return FALSE;
5549}
5550static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5551{
5552  sleftv t;
5553  sleftv ut;
5554  leftv p=NULL;
5555  intvec *iv=(intvec *)w->Data();
5556  int l;
5557  BOOLEAN nok;
5558
5559  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5560  {
5561    WerrorS("cannot build expression lists from unnamed objects");
5562    return TRUE;
5563  }
5564  memcpy(&ut,u,sizeof(ut));
5565  memset(&t,0,sizeof(t));
5566  t.rtyp=INT_CMD;
5567  for (l=0;l< iv->length(); l++)
5568  {
5569    t.data=(char *)(long)((*iv)[l]);
5570    if (p==NULL)
5571    {
5572      p=res;
5573    }
5574    else
5575    {
5576      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5577      p=p->next;
5578    }
5579    memcpy(u,&ut,sizeof(ut));
5580    if (u->Typ() == MATRIX_CMD)
5581      nok=jjBRACK_Ma(p,u,v,&t);
5582    else if (u->Typ() == BIGINTMAT_CMD)
5583      nok=jjBRACK_Bim(p,u,v,&t);
5584    else /* INTMAT_CMD */
5585      nok=jjBRACK_Im(p,u,v,&t);
5586    if (nok)
5587    {
5588      while (res->next!=NULL)
5589      {
5590        p=res->next->next;
5591        omFreeBin((ADDRESS)res->next, sleftv_bin);
5592        // res->e aufraeumen !!!!
5593        res->next=p;
5594      }
5595      return TRUE;
5596    }
5597  }
5598  return FALSE;
5599}
5600static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5601{
5602  sleftv t;
5603  sleftv ut;
5604  leftv p=NULL;
5605  intvec *iv=(intvec *)v->Data();
5606  int l;
5607  BOOLEAN nok;
5608
5609  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5610  {
5611    WerrorS("cannot build expression lists from unnamed objects");
5612    return TRUE;
5613  }
5614  memcpy(&ut,u,sizeof(ut));
5615  memset(&t,0,sizeof(t));
5616  t.rtyp=INT_CMD;
5617  for (l=0;l< iv->length(); l++)
5618  {
5619    t.data=(char *)(long)((*iv)[l]);
5620    if (p==NULL)
5621    {
5622      p=res;
5623    }
5624    else
5625    {
5626      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5627      p=p->next;
5628    }
5629    memcpy(u,&ut,sizeof(ut));
5630    if (u->Typ() == MATRIX_CMD)
5631      nok=jjBRACK_Ma(p,u,&t,w);
5632    else if (u->Typ() == BIGINTMAT_CMD)
5633      nok=jjBRACK_Bim(p,u,&t,w);
5634    else /* INTMAT_CMD */
5635      nok=jjBRACK_Im(p,u,&t,w);
5636    if (nok)
5637    {
5638      while (res->next!=NULL)
5639      {
5640        p=res->next->next;
5641        omFreeBin((ADDRESS)res->next, sleftv_bin);
5642        // res->e aufraeumen !!
5643        res->next=p;
5644      }
5645      return TRUE;
5646    }
5647  }
5648  return FALSE;
5649}
5650static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5651{
5652  sleftv t1,t2,ut;
5653  leftv p=NULL;
5654  intvec *vv=(intvec *)v->Data();
5655  intvec *wv=(intvec *)w->Data();
5656  int vl;
5657  int wl;
5658  BOOLEAN nok;
5659
5660  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5661  {
5662    WerrorS("cannot build expression lists from unnamed objects");
5663    return TRUE;
5664  }
5665  memcpy(&ut,u,sizeof(ut));
5666  memset(&t1,0,sizeof(sleftv));
5667  memset(&t2,0,sizeof(sleftv));
5668  t1.rtyp=INT_CMD;
5669  t2.rtyp=INT_CMD;
5670  for (vl=0;vl< vv->length(); vl++)
5671  {
5672    t1.data=(char *)(long)((*vv)[vl]);
5673    for (wl=0;wl< wv->length(); wl++)
5674    {
5675      t2.data=(char *)(long)((*wv)[wl]);
5676      if (p==NULL)
5677      {
5678        p=res;
5679      }
5680      else
5681      {
5682        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5683        p=p->next;
5684      }
5685      memcpy(u,&ut,sizeof(ut));
5686      if (u->Typ() == MATRIX_CMD)
5687        nok=jjBRACK_Ma(p,u,&t1,&t2);
5688      else if (u->Typ() == BIGINTMAT_CMD)
5689        nok=jjBRACK_Bim(p,u,&t1,&t2);
5690      else /* INTMAT_CMD */
5691        nok=jjBRACK_Im(p,u,&t1,&t2);
5692      if (nok)
5693      {
5694        res->CleanUp();
5695        return TRUE;
5696      }
5697    }
5698  }
5699  return FALSE;
5700}
5701static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5702{
5703  v->next=(leftv)omAllocBin(sleftv_bin);
5704  memcpy(v->next,w,sizeof(sleftv));
5705  memset(w,0,sizeof(sleftv));
5706  return jjPROC(res,u,v);
5707}
5708static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5709{
5710  intvec *iv;
5711  ideal m;
5712  lists l=(lists)omAllocBin(slists_bin);
5713  int k=(int)(long)w->Data();
5714  if (k>=0)
5715  {
5716    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5717    l->Init(2);
5718    l->m[0].rtyp=MODUL_CMD;
5719    l->m[1].rtyp=INTVEC_CMD;
5720    l->m[0].data=(void *)m;
5721    l->m[1].data=(void *)iv;
5722  }
5723  else
5724  {
5725    m=sm_CallSolv((ideal)u->Data(), currRing);
5726    l->Init(1);
5727    l->m[0].rtyp=IDEAL_CMD;
5728    l->m[0].data=(void *)m;
5729  }
5730  res->data = (char *)l;
5731  return FALSE;
5732}
5733static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5734{
5735  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5736  {
5737    WerrorS("3rd argument must be a name of a matrix");
5738    return TRUE;
5739  }
5740  ideal i=(ideal)u->Data();
5741  int rank=(int)i->rank;
5742  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5743  if (r) return TRUE;
5744  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5745  return FALSE;
5746}
5747static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5748{
5749  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5750           (ideal)(v->Data()),(poly)(w->Data()));
5751  return FALSE;
5752}
5753static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5754{
5755  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5756  {
5757    WerrorS("3rd argument must be a name of a matrix");
5758    return TRUE;
5759  }
5760  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5761  poly p=(poly)u->CopyD(POLY_CMD);
5762  ideal i=idInit(1,1);
5763  i->m[0]=p;
5764  sleftv t;
5765  memset(&t,0,sizeof(t));
5766  t.data=(char *)i;
5767  t.rtyp=IDEAL_CMD;
5768  int rank=1;
5769  if (u->Typ()==VECTOR_CMD)
5770  {
5771    i->rank=rank=pMaxComp(p);
5772    t.rtyp=MODUL_CMD;
5773  }
5774  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5775  t.CleanUp();
5776  if (r) return TRUE;
5777  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5778  return FALSE;
5779}
5780static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5781{
5782  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5783    (intvec *)w->Data());
5784  //setFlag(res,FLAG_STD);
5785  return FALSE;
5786}
5787static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5788{
5789  /*4
5790  * look for the substring what in the string where
5791  * starting at position n
5792  * return the position of the first char of what in where
5793  * or 0
5794  */
5795  int n=(int)(long)w->Data();
5796  char *where=(char *)u->Data();
5797  char *what=(char *)v->Data();
5798  char *found;
5799  if ((1>n)||(n>(int)strlen(where)))
5800  {
5801    Werror("start position %d out of range",n);
5802    return TRUE;
5803  }
5804  found = strchr(where+n-1,*what);
5805  if (*(what+1)!='\0')
5806  {
5807    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5808    {
5809      found=strchr(found+1,*what);
5810    }
5811  }
5812  if (found != NULL)
5813  {
5814    res->data=(char *)((found-where)+1);
5815  }
5816  return FALSE;
5817}
5818static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5819{
5820  if ((int)(long)w->Data()==0)
5821    res->data=(char *)walkProc(u,v);
5822  else
5823    res->data=(char *)fractalWalkProc(u,v);
5824  setFlag( res, FLAG_STD );
5825  return FALSE;
5826}
5827static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5828{
5829  intvec *wdegree=(intvec*)w->Data();
5830  if (wdegree->length()!=currRing->N)
5831  {
5832    Werror("weight vector must have size %d, not %d",
5833           currRing->N,wdegree->length());
5834    return TRUE;
5835  }
5836#ifdef HAVE_RINGS
5837  if (rField_is_Ring_Z(currRing))
5838  {
5839    ring origR = currRing;
5840    ring tempR = rCopy(origR);
5841    coeffs new_cf=nInitChar(n_Q,NULL);
5842    nKillChar(tempR->cf);
5843    tempR->cf=new_cf;
5844    rComplete(tempR);
5845    ideal uid = (ideal)u->Data();
5846    rChangeCurrRing(tempR);
5847    ideal uu = idrCopyR(uid, origR, currRing);
5848    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5849    uuAsLeftv.rtyp = IDEAL_CMD;
5850    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5851    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5852    assumeStdFlag(&uuAsLeftv);
5853    Print("// NOTE: computation of Hilbert series etc. is being\n");
5854    Print("//       performed for generic fibre, that is, over Q\n");
5855    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5856    intvec *iv=hFirstSeries(uu,module_w,currRing->qideal,wdegree);
5857    int returnWithTrue = 1;
5858    switch((int)(long)v->Data())
5859    {
5860      case 1:
5861        res->data=(void *)iv;
5862        returnWithTrue = 0;
5863      case 2:
5864        res->data=(void *)hSecondSeries(iv);
5865        delete iv;
5866        returnWithTrue = 0;
5867    }
5868    if (returnWithTrue)
5869    {
5870      WerrorS(feNotImplemented);
5871      delete iv;
5872    }
5873    idDelete(&uu);
5874    rChangeCurrRing(origR);
5875    rDelete(tempR);
5876    if (returnWithTrue) return TRUE; else return FALSE;
5877  }
5878#endif
5879  assumeStdFlag(u);
5880  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5881  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
5882  switch((int)(long)v->Data())
5883  {
5884    case 1:
5885      res->data=(void *)iv;
5886      return FALSE;
5887    case 2:
5888      res->data=(void *)hSecondSeries(iv);
5889      delete iv;
5890      return FALSE;
5891  }
5892  WerrorS(feNotImplemented);
5893  delete iv;
5894  return TRUE;
5895}
5896static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
5897{
5898  PrintS("TODO\n");
5899  int i=pVar((poly)v->Data());
5900  if (i==0)
5901  {
5902    WerrorS("ringvar expected");
5903    return TRUE;
5904  }
5905  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5906  int d=pWTotaldegree(p);
5907  pLmDelete(p);
5908  if (d==1)
5909    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5910  else
5911    WerrorS("variable must have weight 1");
5912  return (d!=1);
5913}
5914static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
5915{
5916  PrintS("TODO\n");
5917  int i=pVar((poly)v->Data());
5918  if (i==0)
5919  {
5920    WerrorS("ringvar expected");
5921    return TRUE;
5922  }
5923  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5924  int d=pWTotaldegree(p);
5925  pLmDelete(p);
5926  if (d==1)
5927    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5928  else
5929    WerrorS("variable must have weight 1");
5930  return (d!=1);
5931}
5932static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5933{
5934  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5935  intvec* arg = (intvec*) u->Data();
5936  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5937
5938  for (i=0; i<n; i++)
5939  {
5940    (*im)[i] = (*arg)[i];
5941  }
5942
5943  res->data = (char *)im;
5944  return FALSE;
5945}
5946static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5947{
5948  short *iw=iv2array((intvec *)w->Data(),currRing);
5949  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5950  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
5951  return FALSE;
5952}
5953static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5954{
5955  if (!pIsUnit((poly)v->Data()))
5956  {
5957    WerrorS("2nd argument must be a unit");
5958    return TRUE;
5959  }
5960  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5961  return FALSE;
5962}
5963static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5964{
5965  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5966                             (intvec *)w->Data(),currRing);
5967  return FALSE;
5968}
5969static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5970{
5971  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
5972  {
5973    WerrorS("2nd argument must be a diagonal matrix of units");
5974    return TRUE;
5975  }
5976  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5977                               (matrix)v->CopyD());
5978  return FALSE;
5979}
5980static BOOLEAN currRingIsOverIntegralDomain ()
5981{
5982  /* true for fields and Z, false otherwise */
5983  if (rField_is_Ring_PtoM(currRing)) return FALSE;
5984  if (rField_is_Ring_2toM(currRing)) return FALSE;
5985  if (rField_is_Ring_ModN(currRing)) return FALSE;
5986  return TRUE;
5987}
5988static BOOLEAN jjMINOR_M(leftv res, leftv v)
5989{
5990  /* Here's the use pattern for the minor command:
5991        minor ( matrix_expression m, int_expression minorSize,
5992                optional ideal_expression IasSB, optional int_expression k,
5993                optional string_expression algorithm,
5994                optional int_expression cachedMinors,
5995                optional int_expression cachedMonomials )
5996     This method here assumes that there are at least two arguments.
5997     - If IasSB is present, it must be a std basis. All minors will be
5998       reduced w.r.t. IasSB.
5999     - If k is absent, all non-zero minors will be computed.
6000       If k is present and k > 0, the first k non-zero minors will be
6001       computed.
6002       If k is present and k < 0, the first |k| minors (some of which
6003       may be zero) will be computed.
6004       If k is present and k = 0, an error is reported.
6005     - If algorithm is absent, all the following arguments must be absent too.
6006       In this case, a heuristic picks the best-suited algorithm (among
6007       Bareiss, Laplace, and Laplace with caching).
6008       If algorithm is present, it must be one of "Bareiss", "bareiss",
6009       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6010       "cache" two more arguments may be given, determining how many entries
6011       the cache may have at most, and how many cached monomials there are at
6012       most. (Cached monomials are counted over all cached polynomials.)
6013       If these two additional arguments are not provided, 200 and 100000
6014       will be used as defaults.
6015  */
6016  matrix m;
6017  leftv u=v->next;
6018  v->next=NULL;
6019  int v_typ=v->Typ();
6020  if (v_typ==MATRIX_CMD)
6021  {
6022     m = (const matrix)v->Data();
6023  }
6024  else
6025  {
6026    if (v_typ==0)
6027    {
6028      Werror("`%s` is undefined",v->Fullname());
6029      return TRUE;
6030    }
6031    // try to convert to MATRIX:
6032    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6033    BOOLEAN bo;
6034    sleftv tmp;
6035    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6036    else bo=TRUE;
6037    if (bo)
6038    {
6039      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6040      return TRUE;
6041    }
6042    m=(matrix)tmp.data;
6043  }
6044  const int mk = (const int)(long)u->Data();
6045  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6046  bool noCacheMinors = true; bool noCacheMonomials = true;
6047  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6048
6049  /* here come the different cases of correct argument sets */
6050  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6051  {
6052    IasSB = (ideal)u->next->Data();
6053    noIdeal = false;
6054    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6055    {
6056      k = (int)(long)u->next->next->Data();
6057      noK = false;
6058      assume(k != 0);
6059      if ((u->next->next->next != NULL) &&
6060          (u->next->next->next->Typ() == STRING_CMD))
6061      {
6062        algorithm = (char*)u->next->next->next->Data();
6063        noAlgorithm = false;
6064        if ((u->next->next->next->next != NULL) &&
6065            (u->next->next->next->next->Typ() == INT_CMD))
6066        {
6067          cacheMinors = (int)(long)u->next->next->next->next->Data();
6068          noCacheMinors = false;
6069          if ((u->next->next->next->next->next != NULL) &&
6070              (u->next->next->next->next->next->Typ() == INT_CMD))
6071          {
6072            cacheMonomials =
6073               (int)(long)u->next->next->next->next->next->Data();
6074            noCacheMonomials = false;
6075          }
6076        }
6077      }
6078    }
6079  }
6080  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6081  {
6082    k = (int)(long)u->next->Data();
6083    noK = false;
6084    assume(k != 0);
6085    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6086    {
6087      algorithm = (char*)u->next->next->Data();
6088      noAlgorithm = false;
6089      if ((u->next->next->next != NULL) &&
6090          (u->next->next->next->Typ() == INT_CMD))
6091      {
6092        cacheMinors = (int)(long)u->next->next->next->Data();
6093        noCacheMinors = false;
6094        if ((u->next->next->next->next != NULL) &&
6095            (u->next->next->next->next->Typ() == INT_CMD))
6096        {
6097          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6098          noCacheMonomials = false;
6099        }
6100      }
6101    }
6102  }
6103  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6104  {
6105    algorithm = (char*)u->next->Data();
6106    noAlgorithm = false;
6107    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6108    {
6109      cacheMinors = (int)(long)u->next->next->Data();
6110      noCacheMinors = false;
6111      if ((u->next->next->next != NULL) &&
6112          (u->next->next->next->Typ() == INT_CMD))
6113      {
6114        cacheMonomials = (int)(long)u->next->next->next->Data();
6115        noCacheMonomials = false;
6116      }
6117    }
6118  }
6119
6120  /* upper case conversion for the algorithm if present */
6121  if (!noAlgorithm)
6122  {
6123    if (strcmp(algorithm, "bareiss") == 0)
6124      algorithm = (char*)"Bareiss";
6125    if (strcmp(algorithm, "laplace") == 0)
6126      algorithm = (char*)"Laplace";
6127    if (strcmp(algorithm, "cache") == 0)
6128      algorithm = (char*)"Cache";
6129  }
6130
6131  v->next=u;
6132  /* here come some tests */
6133  if (!noIdeal)
6134  {
6135    assumeStdFlag(u->next);
6136  }
6137  if ((!noK) && (k == 0))
6138  {
6139    WerrorS("Provided number of minors to be computed is zero.");
6140    return TRUE;
6141  }
6142  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6143      && (strcmp(algorithm, "Laplace") != 0)
6144      && (strcmp(algorithm, "Cache") != 0))
6145  {
6146    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6147    return TRUE;
6148  }
6149  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6150      && (!currRingIsOverIntegralDomain()))
6151  {
6152    Werror("Bareiss algorithm not defined over coefficient rings %s",
6153           "with zero divisors.");
6154    return TRUE;
6155  }
6156  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6157  {
6158    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6159           m->rows(), m->cols());
6160    return TRUE;
6161  }
6162  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6163      && (noCacheMinors || noCacheMonomials))
6164  {
6165    cacheMinors = 200;
6166    cacheMonomials = 100000;
6167  }
6168
6169  /* here come the actual procedure calls */
6170  if (noAlgorithm)
6171    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6172                                       (noIdeal ? 0 : IasSB), false);
6173  else if (strcmp(algorithm, "Cache") == 0)
6174    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6175                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6176                                   cacheMonomials, false);
6177  else
6178    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6179                              (noIdeal ? 0 : IasSB), false);
6180  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6181  res->rtyp = IDEAL_CMD;
6182  return FALSE;
6183}
6184static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6185{
6186  // u: the name of the new type
6187  // v: the parent type
6188  // w: the elements
6189  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6190                                            (const char *)w->Data());
6191  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6192  return (d==NULL);
6193}
6194static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6195{
6196  // handles preimage(r,phi,i) and kernel(r,phi)
6197  idhdl h;
6198  ring rr;
6199  map mapping;
6200  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6201
6202  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6203  {
6204    WerrorS("2nd/3rd arguments must have names");
6205    return TRUE;
6206  }
6207  rr=(ring)u->Data();
6208  const char *ring_name=u->Name();
6209  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6210  {
6211    if (h->typ==MAP_CMD)
6212    {
6213      mapping=IDMAP(h);
6214      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6215      if ((preim_ring==NULL)
6216      || (IDRING(preim_ring)!=currRing))
6217      {
6218        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6219        return TRUE;
6220      }
6221    }
6222    else if (h->typ==IDEAL_CMD)
6223    {
6224      mapping=IDMAP(h);
6225    }
6226    else
6227    {
6228      Werror("`%s` is no map nor ideal",IDID(h));
6229      return TRUE;
6230    }
6231  }
6232  else
6233  {
6234    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6235    return TRUE;
6236  }
6237  ideal image;
6238  if (kernel_cmd) image=idInit(1,1);
6239  else
6240  {
6241    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6242    {
6243      if (h->typ==IDEAL_CMD)
6244      {
6245        image=IDIDEAL(h);
6246      }
6247      else
6248      {
6249        Werror("`%s` is no ideal",IDID(h));
6250        return TRUE;
6251      }
6252    }
6253    else
6254    {
6255      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6256      return TRUE;
6257    }
6258  }
6259  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6260  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6261  {
6262    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6263  }
6264  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6265  if (kernel_cmd) idDelete(&image);
6266  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6267}
6268static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6269{
6270  int di, k;
6271  int i=(int)(long)u->Data();
6272  int r=(int)(long)v->Data();
6273  int c=(int)(long)w->Data();
6274  if ((r<=0) || (c<=0)) return TRUE;
6275  intvec *iv = new intvec(r, c, 0);
6276  if (iv->rows()==0)
6277  {
6278    delete iv;
6279    return TRUE;
6280  }
6281  if (i!=0)
6282  {
6283    if (i<0) i = -i;
6284    di = 2 * i + 1;
6285    for (k=0; k<iv->length(); k++)
6286    {
6287      (*iv)[k] = ((siRand() % di) - i);
6288    }
6289  }
6290  res->data = (char *)iv;
6291  return FALSE;
6292}
6293#ifdef SINGULAR_4_1
6294static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6295// <coeff>, par1, par2 -> number2
6296{
6297  coeffs cf=(coeffs)u->Data();
6298  if ((cf!=NULL) && (cf->cfRandom!=NULL))
6299  {
6300    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6301    number2 nn=(number2)omAlloc(sizeof(*nn));
6302    nn->cf=cf;
6303    nn->n=n;
6304    res->data=nn;
6305    return FALSE;
6306  }
6307  return TRUE;
6308}
6309#endif
6310static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6311  int &ringvar, poly &monomexpr)
6312{
6313  monomexpr=(poly)w->Data();
6314  poly p=(poly)v->Data();
6315#if 0
6316  if (pLength(monomexpr)>1)
6317  {
6318    Werror("`%s` substitutes a ringvar only by a term",
6319      Tok2Cmdname(SUBST_CMD));
6320    return TRUE;
6321  }
6322#endif
6323  if ((ringvar=pVar(p))==0)
6324  {
6325    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6326    {
6327      number n = pGetCoeff(p);
6328      ringvar= -n_IsParam(n, currRing);
6329    }
6330    if(ringvar==0)
6331    {
6332      WerrorS("ringvar/par expected");
6333      return TRUE;
6334    }
6335  }
6336  return FALSE;
6337}
6338static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6339{
6340  int ringvar;
6341  poly monomexpr;
6342  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6343  if (nok) return TRUE;
6344  poly p=(poly)u->Data();
6345  if (ringvar>0)
6346  {
6347    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6348    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p)/2)))
6349    {
6350      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), pTotaldegree(p));
6351      //return TRUE;
6352    }
6353    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6354      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6355    else
6356      res->data= pSubstPoly(p,ringvar,monomexpr);
6357  }
6358  else
6359  {
6360    res->data=pSubstPar(p,-ringvar,monomexpr);
6361  }
6362  return FALSE;
6363}
6364static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6365{
6366  int ringvar;
6367  poly monomexpr;
6368  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6369  if (nok) return TRUE;
6370  ideal id=(ideal)u->Data();
6371  if (ringvar>0)
6372  {
6373    BOOLEAN overflow=FALSE;
6374    if (monomexpr!=NULL)
6375    {
6376      long deg_monexp=pTotaldegree(monomexpr);
6377      for(int i=IDELEMS(id)-1;i>=0;i--)
6378      {
6379        poly p=id->m[i];
6380        if ((p!=NULL) && (pTotaldegree(p)!=0) &&
6381        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)pTotaldegree(p)/2)))
6382        {
6383          overflow=TRUE;
6384          break;
6385        }
6386      }
6387    }
6388    if (overflow)
6389      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6390    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6391    {
6392      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6393      else                       id=id_Copy(id,currRing);
6394      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6395    }
6396    else
6397      res->data = idSubstPoly(id,ringvar,monomexpr);
6398  }
6399  else
6400  {
6401    res->data = idSubstPar(id,-ringvar,monomexpr);
6402  }
6403  return FALSE;
6404}
6405// we do not want to have jjSUBST_Id_X inlined:
6406static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6407                            int input_type);
6408static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6409{
6410  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6411}
6412static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6413{
6414  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6415}
6416static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6417{
6418  sleftv tmp;
6419  memset(&tmp,0,sizeof(tmp));
6420  // do not check the result, conversion from int/number to poly works always
6421  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6422  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6423  tmp.CleanUp();
6424  return b;
6425}
6426static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6427{
6428  int mi=(int)(long)v->Data();
6429  int ni=(int)(long)w->Data();
6430  if ((mi<1)||(ni<1))
6431  {
6432    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6433    return TRUE;
6434  }
6435  matrix m=mpNew(mi,ni);
6436  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6437  int i=si_min(IDELEMS(I),mi*ni);
6438  //for(i=i-1;i>=0;i--)
6439  //{
6440  //  m->m[i]=I->m[i];
6441  //  I->m[i]=NULL;
6442  //}
6443  memcpy(m->m,I->m,i*sizeof(poly));
6444  memset(I->m,0,i*sizeof(poly));
6445  id_Delete(&I,currRing);
6446  res->data = (char *)m;
6447  return FALSE;
6448}
6449static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6450{
6451  int mi=(int)(long)v->Data();
6452  int ni=(int)(long)w->Data();
6453  if ((mi<1)||(ni<1))
6454  {
6455    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6456    return TRUE;
6457  }
6458  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6459           mi,ni,currRing);
6460  return FALSE;
6461}
6462static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6463{
6464  int mi=(int)(long)v->Data();
6465  int ni=(int)(long)w->Data();
6466  if ((mi<1)||(ni<1))
6467  {
6468     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6469    return TRUE;
6470  }
6471  matrix m=mpNew(mi,ni);
6472  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6473  int r=si_min(MATROWS(I),mi);
6474  int c=si_min(MATCOLS(I),ni);
6475  int i,j;
6476  for(i=r;i>0;i--)
6477  {
6478    for(j=c;j>0;j--)
6479    {
6480      MATELEM(m,i,j)=MATELEM(I,i,j);
6481      MATELEM(I,i,j)=NULL;
6482    }
6483  }
6484  id_Delete((ideal *)&I,currRing);
6485  res->data = (char *)m;
6486  return FALSE;
6487}
6488static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6489{
6490  if (w->rtyp!=IDHDL) return TRUE;
6491  int ul= IDELEMS((ideal)u->Data());
6492  int vl= IDELEMS((ideal)v->Data());
6493  ideal m
6494    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6495             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6496  if (m==NULL) return TRUE;
6497  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6498  return FALSE;
6499}
6500static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6501{
6502  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6503  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6504  idhdl hv=(idhdl)v->data;
6505  idhdl hw=(idhdl)w->data;
6506  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6507  res->data = (char *)idLiftStd((ideal)u->Data(),
6508                                &(hv->data.umatrix),testHomog,
6509                                &(hw->data.uideal));
6510  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6511  return FALSE;
6512}
6513static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6514{
6515  assumeStdFlag(v);
6516  if (!idIsZeroDim((ideal)v->Data()))
6517  {
6518    Werror("`%s` must be 0-dimensional",v->Name());
6519    return TRUE;
6520  }
6521  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6522    (poly)w->CopyD());
6523  return FALSE;
6524}
6525static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6526{
6527  assumeStdFlag(v);
6528  if (!idIsZeroDim((ideal)v->Data()))
6529  {
6530    Werror("`%s` must be 0-dimensional",v->Name());
6531    return TRUE;
6532  }
6533  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6534    (matrix)w->CopyD());
6535  return FALSE;
6536}
6537static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6538{
6539  assumeStdFlag(v);
6540  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6541    0,(int)(long)w->Data());
6542  return FALSE;
6543}
6544static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6545{
6546  assumeStdFlag(v);
6547  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6548    0,(int)(long)w->Data());
6549  return FALSE;
6550}
6551#ifdef OLD_RES
6552static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6553{
6554  int maxl=(int)v->Data();
6555  ideal u_id=(ideal)u->Data();
6556  int l=0;
6557  resolvente r;
6558  intvec **weights=NULL;
6559  int wmaxl=maxl;
6560  maxl--;
6561  if ((maxl==-1) && (iiOp!=MRES_CMD))
6562    maxl = currRing->N-1;
6563  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6564  {
6565    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6566    if (iv!=NULL)
6567    {
6568      l=1;
6569      if (!idTestHomModule(u_id,currRing->qideal,iv))
6570      {
6571        WarnS("wrong weights");
6572        iv=NULL;
6573      }
6574      else
6575      {
6576        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6577        weights[0] = ivCopy(iv);
6578      }
6579    }
6580    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6581  }
6582  else
6583    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6584  if (r==NULL) return TRUE;
6585  int t3=u->Typ();
6586  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6587  return FALSE;
6588}
6589#endif
6590static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6591{
6592  res->data=(void *)rInit(u,v,w);
6593  return (res->data==NULL);
6594}
6595static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6596{
6597  int yes;
6598  jjSTATUS2(res, u, v);
6599  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6600  omFree((ADDRESS) res->data);
6601  res->data = (void *)(long)yes;
6602  return FALSE;
6603}
6604static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6605{
6606  intvec *vw=(intvec *)w->Data(); // weights of vars
6607  if (vw->length()!=currRing->N)
6608  {
6609    Werror("%d weights for %d variables",vw->length(),currRing->N);
6610    return TRUE;
6611  }
6612  ideal result;
6613  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6614  tHomog hom=testHomog;
6615  ideal u_id=(ideal)(u->Data());
6616  if (ww!=NULL)
6617  {
6618    if (!idTestHomModule(u_id,currRing->qideal,ww))
6619    {
6620      WarnS("wrong weights");
6621      ww=NULL;
6622    }
6623    else
6624    {
6625      ww=ivCopy(ww);
6626      hom=isHomog;
6627    }
6628  }
6629  result=kStd(u_id,
6630              currRing->qideal,
6631              hom,
6632              &ww,                  // module weights
6633              (intvec *)v->Data(),  // hilbert series
6634              0,0,                  // syzComp, newIdeal
6635              vw);                  // weights of vars
6636  idSkipZeroes(result);
6637  res->data = (char *)result;
6638  setFlag(res,FLAG_STD);
6639  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6640  return FALSE;
6641}
6642
6643/*=================== operations with many arg.: static proc =================*/
6644/* must be ordered: first operations for chars (infix ops),
6645 * then alphabetically */
6646static BOOLEAN jjBREAK0(leftv, leftv)
6647{
6648#ifdef HAVE_SDB
6649  sdb_show_bp();
6650#endif
6651  return FALSE;
6652}
6653static BOOLEAN jjBREAK1(leftv, leftv v)
6654{
6655#ifdef HAVE_SDB
6656  if(v->Typ()==PROC_CMD)
6657  {
6658    int lineno=0;
6659    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6660    {
6661      lineno=(int)(long)v->next->Data();
6662    }
6663    return sdb_set_breakpoint(v->Name(),lineno);
6664  }
6665  return TRUE;
6666#else
6667 return FALSE;
6668#endif
6669}
6670static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6671{
6672  return iiExprArith1(res,v,iiOp);
6673}
6674static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6675{
6676  leftv v=u->next;
6677  u->next=NULL;
6678  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6679  u->next=v;
6680  return b;
6681}
6682static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6683{
6684  leftv v = u->next;
6685  leftv w = v->next;
6686  u->next = NULL;
6687  v->next = NULL;
6688  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6689  u->next = v;
6690  v->next = w;
6691  return b;
6692}
6693
6694static BOOLEAN jjCOEF_M(leftv, leftv v)
6695{
6696  short t[]={5,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD,IDHDL};
6697  if (iiCheckTypes(v,t))
6698     return TRUE;
6699  idhdl c=(idhdl)v->next->next->data;
6700  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6701  idhdl m=(idhdl)v->next->next->next->data;
6702  idDelete((ideal *)&(c->data.uideal));
6703  idDelete((ideal *)&(m->data.uideal));
6704  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6705    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6706  return FALSE;
6707}
6708
6709static BOOLEAN jjDIVISION4(leftv res, leftv v)
6710{ // may have 3 or 4 arguments
6711  leftv v1=v;
6712  leftv v2=v1->next;
6713  leftv v3=v2->next;
6714  leftv v4=v3->next;
6715  assumeStdFlag(v2);
6716
6717  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6718  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6719
6720  if((i1==0)||(i2==0)
6721  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6722  {
6723    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6724    return TRUE;
6725  }
6726
6727  sleftv w1,w2;
6728  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6729  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6730  ideal P=(ideal)w1.Data();
6731  ideal Q=(ideal)w2.Data();
6732
6733  int n=(int)(long)v3->Data();
6734  short *w=NULL;
6735  if(v4!=NULL)
6736  {
6737    w = iv2array((intvec *)v4->Data(),currRing);
6738    short * w0 = w + 1;
6739    int i = currRing->N;
6740    while( (i > 0) && ((*w0) > 0) )
6741    {
6742      w0++;
6743      i--;
6744    }
6745    if(i>0)
6746      WarnS("not all weights are positive!");
6747  }
6748
6749  matrix T;
6750  ideal R;
6751  idLiftW(P,Q,n,T,R,w);
6752
6753  w1.CleanUp();
6754  w2.CleanUp();
6755  if(w!=NULL)
6756    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
6757
6758  lists L=(lists) omAllocBin(slists_bin);
6759  L->Init(2);
6760  L->m[1].rtyp=v1->Typ();
6761  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6762  {
6763    if(v1->Typ()==POLY_CMD)
6764      p_Shift(&R->m[0],-1,currRing);
6765    L->m[1].data=(void *)R->m[0];
6766    R->m[0]=NULL;
6767    idDelete(&R);
6768  }
6769  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6770    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6771  else
6772  {
6773    L->m[1].rtyp=MODUL_CMD;
6774    L->m[1].data=(void *)R;
6775  }
6776  L->m[0].rtyp=MATRIX_CMD;
6777  L->m[0].data=(char *)T;
6778
6779  res->data=L;
6780  res->rtyp=LIST_CMD;
6781
6782  return FALSE;
6783}
6784
6785//BOOLEAN jjDISPATCH(leftv res, leftv v)
6786//{
6787//  WerrorS("`dispatch`: not implemented");
6788//  return TRUE;
6789//}
6790
6791//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6792//{
6793//  int l=u->listLength();
6794//  if (l<2) return TRUE;
6795//  BOOLEAN b;
6796//  leftv v=u->next;
6797//  leftv zz=v;
6798//  leftv z=zz;
6799//  u->next=NULL;
6800//  do
6801//  {
6802//    leftv z=z->next;
6803//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6804//    if (b) break;
6805//  } while (z!=NULL);
6806//  u->next=zz;
6807//  return b;
6808//}
6809static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6810{
6811  int s=1;
6812  leftv h=v;
6813  if (h!=NULL) s=exprlist_length(h);
6814  ideal id=idInit(s,1);
6815  int rank=1;
6816  int i=0;
6817  poly p;
6818  while (h!=NULL)
6819  {
6820    switch(h->Typ())
6821    {
6822      case POLY_CMD:
6823      {
6824        p=(poly)h->CopyD(POLY_CMD);
6825        break;
6826      }
6827      case INT_CMD:
6828      {
6829        number n=nInit((int)(long)h->Data());
6830        if (!nIsZero(n))
6831        {
6832          p=pNSet(n);
6833        }
6834        else
6835        {
6836          p=NULL;
6837          nDelete(&n);
6838        }
6839        break;
6840      }
6841      case BIGINT_CMD:
6842      {
6843        number b=(number)h->Data();
6844        nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
6845        if (nMap==NULL) return TRUE;
6846        number n=nMap(b,coeffs_BIGINT,currRing->cf);
6847        if (!nIsZero(n))
6848        {
6849          p=pNSet(n);
6850        }
6851        else
6852        {
6853          p=NULL;
6854          nDelete(&n);
6855        }
6856        break;
6857      }
6858      case NUMBER_CMD:
6859      {
6860        number n=(number)h->CopyD(NUMBER_CMD);
6861        if (!nIsZero(n))
6862        {
6863          p=pNSet(n);
6864        }
6865        else
6866        {
6867          p=NULL;
6868          nDelete(&n);
6869        }
6870        break;
6871      }
6872      case VECTOR_CMD:
6873      {
6874        p=(poly)h->CopyD(VECTOR_CMD);
6875        if (iiOp!=MODUL_CMD)
6876        {
6877          idDelete(&id);
6878          pDelete(&p);
6879          return TRUE;
6880        }
6881        rank=si_max(rank,(int)pMaxComp(p));
6882        break;
6883      }
6884      default:
6885      {
6886        idDelete(&id);
6887        return TRUE;
6888      }
6889    }
6890    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6891    {
6892      pSetCompP(p,1);
6893    }
6894    id->m[i]=p;
6895    i++;
6896    h=h->next;
6897  }
6898  id->rank=rank;
6899  res->data=(char *)id;
6900  return FALSE;
6901}
6902static BOOLEAN jjFETCH_M(leftv res, leftv u)
6903{
6904  ring r=(ring)u->Data();
6905  leftv v=u->next;
6906  leftv perm_var_l=v->next;
6907  leftv perm_par_l=v->next->next;
6908  if ((perm_var_l->Typ()!=INTVEC_CMD)
6909  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
6910  ||((u->Typ()!=RING_CMD)&&(u->Typ()!=QRING_CMD)))
6911  {
6912    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
6913    return TRUE;
6914  }
6915  intvec *perm_var_v=(intvec*)perm_var_l->Data();
6916  intvec *perm_par_v=NULL;
6917  if (perm_par_l!=NULL)
6918    perm_par_v=(intvec*)perm_par_l->Data();
6919  idhdl w;
6920  nMapFunc nMap;
6921
6922  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
6923  {
6924    int *perm=NULL;
6925    int *par_perm=NULL;
6926    int par_perm_size=0;
6927    BOOLEAN bo;
6928    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
6929    {
6930      // Allow imap/fetch to be make an exception only for:
6931      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
6932            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
6933             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
6934           ||
6935           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
6936            (rField_is_Zp(currRing, r->cf->ch) ||
6937             rField_is_Zp_a(currRing, r->cf->ch))) )
6938      {
6939        par_perm_size=rPar(r);
6940      }
6941      else
6942      {
6943        goto err_fetch;
6944      }
6945    }
6946    else
6947      par_perm_size=rPar(r);
6948    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
6949    if (par_perm_size!=0)
6950      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
6951    int i;
6952    if (perm_par_l==NULL)
6953    {
6954      if (par_perm_size!=0)
6955        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
6956    }
6957    else
6958    {
6959      if (par_perm_size==0) WarnS("source ring has no parameters");
6960      else
6961      {
6962        for(i=rPar(r)-1;i>=0;i--)
6963        {
6964          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
6965          if ((par_perm[i]<-rPar(currRing))
6966          || (par_perm[i]>rVar(currRing)))
6967          {
6968            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
6969            par_perm[i]=0;
6970          }
6971        }
6972      }
6973    }
6974    for(i=rVar(r)-1;i>=0;i--)
6975    {
6976      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
6977      if ((perm[i]<-rPar(currRing))
6978      || (perm[i]>rVar(currRing)))
6979      {
6980        Warn("invalid entry for var %d: %d\n",i,perm[i]);
6981        perm[i]=0;
6982      }
6983    }
6984    if (BVERBOSE(V_IMAP))
6985    {
6986      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
6987      {
6988        if (perm[i]>0)
6989          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
6990        else if (perm[i]<0)
6991          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
6992      }
6993      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
6994      {
6995        if (par_perm[i-1]<0)
6996          Print("// par nr %d: %s -> par %s\n",
6997              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
6998        else if (par_perm[i-1]>0)
6999          Print("// par nr %d: %s -> var %s\n",
7000              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7001      }
7002    }
7003    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7004    sleftv tmpW;
7005    memset(&tmpW,0,sizeof(sleftv));
7006    tmpW.rtyp=IDTYP(w);
7007    tmpW.data=IDDATA(w);
7008    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7009                         perm,par_perm,par_perm_size,nMap)))
7010    {
7011      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7012    }
7013    if (perm!=NULL)
7014      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7015    if (par_perm!=NULL)
7016      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7017    return bo;
7018  }
7019  else
7020  {
7021    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7022  }
7023  return TRUE;
7024err_fetch:
7025  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
7026         nCoeffString(r->cf),
7027         nCoeffString(currRing->cf));
7028  return TRUE;
7029}
7030static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7031{
7032  leftv h=v;
7033  int l=v->listLength();
7034  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7035  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7036  int t=0;
7037  // try to convert to IDEAL_CMD
7038  while (h!=NULL)
7039  {
7040    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7041    {
7042      t=IDEAL_CMD;
7043    }
7044    else break;
7045    h=h->next;
7046  }
7047  // if failure, try MODUL_CMD
7048  if (t==0)
7049  {
7050    h=v;
7051    while (h!=NULL)
7052    {
7053      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7054      {
7055        t=MODUL_CMD;
7056      }
7057      else break;
7058      h=h->next;
7059    }
7060  }
7061  // check for success  in converting
7062  if (t==0)
7063  {
7064    WerrorS("cannot convert to ideal or module");
7065    return TRUE;
7066  }
7067  // call idMultSect
7068  h=v;
7069  int i=0;
7070  sleftv tmp;
7071  while (h!=NULL)
7072  {
7073    if (h->Typ()==t)
7074    {
7075      r[i]=(ideal)h->Data(); /*no copy*/
7076      h=h->next;
7077    }
7078    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7079    {
7080      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7081      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7082      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7083      return TRUE;
7084    }
7085    else
7086    {
7087      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7088      copied[i]=TRUE;
7089      h=tmp.next;
7090    }
7091    i++;
7092  }
7093  res->rtyp=t;
7094  res->data=(char *)idMultSect(r,i);
7095  while(i>0)
7096  {
7097    i--;
7098    if (copied[i]) idDelete(&(r[i]));
7099  }
7100  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7101  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7102  return FALSE;
7103}
7104static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7105{
7106  /* computation of the inverse of a quadratic matrix A
7107     using the L-U-decomposition of A;
7108     There are two valid parametrisations:
7109     1) exactly one argument which is just the matrix A,
7110     2) exactly three arguments P, L, U which already
7111        realise the L-U-decomposition of A, that is,
7112        P * A = L * U, and P, L, and U satisfy the
7113        properties decribed in method 'jjLU_DECOMP';
7114        see there;
7115     If A is invertible, the list [1, A^(-1)] is returned,
7116     otherwise the list [0] is returned. Thus, the user may
7117     inspect the first entry of the returned list to see
7118     whether A is invertible. */
7119  matrix iMat; int invertible;
7120  short t1[]={1,MATRIX_CMD};
7121  short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7122  if (iiCheckTypes(v,t1))
7123  {
7124    matrix aMat = (matrix)v->Data();
7125    int rr = aMat->rows();
7126    int cc = aMat->cols();
7127    if (rr != cc)
7128    {
7129      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7130      return TRUE;
7131    }
7132    if (!idIsConstant((ideal)aMat))
7133    {
7134      WerrorS("matrix must be constant");
7135      return TRUE;
7136    }
7137    invertible = luInverse(aMat, iMat);
7138  }
7139  else if (iiCheckTypes(v,t2))
7140  {
7141     matrix pMat = (matrix)v->Data();
7142     matrix lMat = (matrix)v->next->Data();
7143     matrix uMat = (matrix)v->next->next->Data();
7144     int rr = uMat->rows();
7145     int cc = uMat->cols();
7146     if (rr != cc)
7147     {
7148       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7149              rr, cc);
7150       return TRUE;
7151     }
7152      if (!idIsConstant((ideal)pMat)
7153      || (!idIsConstant((ideal)lMat))
7154      || (!idIsConstant((ideal)uMat))
7155      )
7156      {
7157        WerrorS("matricesx must be constant");
7158        return TRUE;
7159      }
7160     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7161  }
7162  else
7163  {
7164    Werror("expected either one or three matrices");
7165    return TRUE;
7166  }
7167
7168  /* build the return structure; a list with either one or two entries */
7169  lists ll = (lists)omAllocBin(slists_bin);
7170  if (invertible)
7171  {
7172    ll->Init(2);
7173    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7174    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7175  }
7176  else
7177  {
7178    ll->Init(1);
7179    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7180  }
7181
7182  res->data=(char*)ll;
7183  return FALSE;
7184}
7185static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7186{
7187  /* for solving a linear equation system A * x = b, via the
7188     given LU-decomposition of the matrix A;
7189     There is one valid parametrisation:
7190     1) exactly four arguments P, L, U, b;
7191        P, L, and U realise the L-U-decomposition of A, that is,
7192        P * A = L * U, and P, L, and U satisfy the
7193        properties decribed in method 'jjLU_DECOMP';
7194        see there;
7195        b is the right-hand side vector of the equation system;
7196     The method will return a list of either 1 entry or three entries:
7197     1) [0] if there is no solution to the system;
7198     2) [1, x, H] if there is at least one solution;
7199        x is any solution of the given linear system,
7200        H is the matrix with column vectors spanning the homogeneous
7201        solution space.
7202     The method produces an error if matrix and vector sizes do not fit. */
7203  short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7204  if (!iiCheckTypes(v,t))
7205  {
7206    WerrorS("expected exactly three matrices and one vector as input");
7207    return TRUE;
7208  }
7209  matrix pMat = (matrix)v->Data();
7210  matrix lMat = (matrix)v->next->Data();
7211  matrix uMat = (matrix)v->next->next->Data();
7212  matrix bVec = (matrix)v->next->next->next->Data();
7213  matrix xVec; int solvable; matrix homogSolSpace;
7214  if (pMat->rows() != pMat->cols())
7215  {
7216    Werror("first matrix (%d x %d) is not quadratic",
7217           pMat->rows(), pMat->cols());
7218    return TRUE;
7219  }
7220  if (lMat->rows() != lMat->cols())
7221  {
7222    Werror("second matrix (%d x %d) is not quadratic",
7223           lMat->rows(), lMat->cols());
7224    return TRUE;
7225  }
7226  if (lMat->rows() != uMat->rows())
7227  {
7228    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7229           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7230    return TRUE;
7231  }
7232  if (uMat->rows() != bVec->rows())
7233  {
7234    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7235           uMat->rows(), uMat->cols(), bVec->rows());
7236    return TRUE;
7237  }
7238  if (!idIsConstant((ideal)pMat)
7239  ||(!idIsConstant((ideal)lMat))
7240  ||(!idIsConstant((ideal)uMat))
7241  )
7242  {
7243    WerrorS("matrices must be constant");
7244    return TRUE;
7245  }
7246  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7247
7248  /* build the return structure; a list with either one or three entries */
7249  lists ll = (lists)omAllocBin(slists_bin);
7250  if (solvable)
7251  {
7252    ll->Init(3);
7253    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7254    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7255    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7256  }
7257  else
7258  {
7259    ll->Init(1);
7260    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7261  }
7262
7263  res->data=(char*)ll;
7264  return FALSE;
7265}
7266static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7267{
7268  int i=0;
7269  leftv h=v;
7270  if (h!=NULL) i=exprlist_length(h);
7271  intvec *iv=new intvec(i);
7272  i=0;
7273  while (h!=NULL)
7274  {
7275    if(h->Typ()==INT_CMD)
7276    {
7277      (*iv)[i]=(int)(long)h->Data();
7278    }
7279    else if (h->Typ()==INTVEC_CMD)
7280    {
7281      intvec *ivv=(intvec*)h->Data();
7282      for(int j=0;j<ivv->length();j++,i++)
7283      {
7284        (*iv)[i]=(*ivv)[j];
7285      }
7286      i--;
7287    }
7288    else
7289    {
7290      delete iv;
7291      return TRUE;
7292    }
7293    i++;
7294    h=h->next;
7295  }
7296  res->data=(char *)iv;
7297  return FALSE;
7298}
7299static BOOLEAN jjJET4(leftv res, leftv u)
7300{
7301  short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7302  short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7303  short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7304  short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7305  leftv u1=u;
7306  leftv u2=u1->next;
7307  leftv u3=u2->next;
7308  leftv u4=u3->next;
7309  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7310  {
7311    if(!pIsUnit((poly)u2->Data()))
7312    {
7313      WerrorS("2nd argument must be a unit");
7314      return TRUE;
7315    }
7316    res->rtyp=u1->Typ();
7317    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7318                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7319    return FALSE;
7320  }
7321  else
7322  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7323  {
7324    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7325    {
7326      WerrorS("2nd argument must be a diagonal matrix of units");
7327      return TRUE;
7328    }
7329    res->rtyp=u1->Typ();
7330    res->data=(char*)idSeries(
7331                              (int)(long)u3->Data(),
7332                              idCopy((ideal)u1->Data()),
7333                              mp_Copy((matrix)u2->Data(), currRing),
7334                              (intvec*)u4->Data()
7335                             );
7336    return FALSE;
7337  }
7338  else
7339  {
7340    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7341           Tok2Cmdname(iiOp));
7342    return TRUE;
7343  }
7344}
7345static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7346{
7347  if ((yyInRingConstruction)
7348  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7349  {
7350    memcpy(res,u,sizeof(sleftv));
7351    memset(u,0,sizeof(sleftv));
7352    return FALSE;
7353  }
7354  leftv v=u->next;
7355  BOOLEAN b;
7356  if(v==NULL)
7357    b=iiExprArith1(res,u,iiOp);
7358  else
7359  {
7360    u->next=NULL;
7361    b=iiExprArith2(res,u,iiOp,v);
7362    u->next=v;
7363  }
7364  return b;
7365}
7366BOOLEAN jjLIST_PL(leftv res, leftv v)
7367{
7368  int sl=0;
7369  if (v!=NULL) sl = v->listLength();
7370  lists L;
7371  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7372  {
7373    int add_row_shift = 0;
7374    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7375    if (weights!=NULL)  add_row_shift=weights->min_in();
7376    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7377  }
7378  else
7379  {
7380    L=(lists)omAllocBin(slists_bin);
7381    leftv h=NULL;
7382    int i;
7383    int rt;
7384
7385    L->Init(sl);
7386    for (i=0;i<sl;i++)
7387    {
7388      if (h!=NULL)
7389      { /* e.g. not in the first step:
7390         * h is the pointer to the old sleftv,
7391         * v is the pointer to the next sleftv
7392         * (in this moment) */
7393         h->next=v;
7394      }
7395      h=v;
7396      v=v->next;
7397      h->next=NULL;
7398      rt=h->Typ();
7399      if (rt==0)
7400      {
7401        L->Clean();
7402        Werror("`%s` is undefined",h->Fullname());
7403        return TRUE;
7404      }
7405      if ((rt==RING_CMD)||(rt==QRING_CMD))
7406      {
7407        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7408        ((ring)L->m[i].data)->ref++;
7409      }
7410      else
7411        L->m[i].Copy(h);
7412    }
7413  }
7414  res->data=(char *)L;
7415  return FALSE;
7416}
7417static BOOLEAN jjNAMES0(leftv res, leftv)
7418{
7419  res->data=(void *)ipNameList(IDROOT);
7420  return FALSE;
7421}
7422static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7423{
7424  if(v==NULL)
7425  {
7426    res->data=(char *)showOption();
7427    return FALSE;
7428  }
7429  res->rtyp=NONE;
7430  return setOption(res,v);
7431}
7432static BOOLEAN jjREDUCE4(leftv res, leftv u)
7433{
7434  leftv u1=u;
7435  leftv u2=u1->next;
7436  leftv u3=u2->next;
7437  leftv u4=u3->next;
7438  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7439  {
7440    int save_d=Kstd1_deg;
7441    Kstd1_deg=(int)(long)u3->Data();
7442    kModW=(intvec *)u4->Data();
7443    BITSET save2;
7444    SI_SAVE_OPT2(save2);
7445    si_opt_2|=Sy_bit(V_DEG_STOP);
7446    u2->next=NULL;
7447    BOOLEAN r=jjCALL2ARG(res,u);
7448    kModW=NULL;
7449    Kstd1_deg=save_d;
7450    SI_RESTORE_OPT2(save2);
7451    u->next->next=u3;
7452    return r;
7453  }
7454  else
7455  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7456     (u4->Typ()==INT_CMD))
7457  {
7458    assumeStdFlag(u3);
7459    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7460    {
7461      WerrorS("2nd argument must be a diagonal matrix of units");
7462      return TRUE;
7463    }
7464    res->rtyp=IDEAL_CMD;
7465    res->data=(char*)redNF(
7466                           idCopy((ideal)u3->Data()),
7467                           idCopy((ideal)u1->Data()),
7468                           mp_Copy((matrix)u2->Data(), currRing),
7469                           (int)(long)u4->Data()
7470                          );
7471    return FALSE;
7472  }
7473  else
7474  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7475     (u4->Typ()==INT_CMD))
7476  {
7477    assumeStdFlag(u3);
7478    if(!pIsUnit((poly)u2->Data()))
7479    {
7480      WerrorS("2nd argument must be a unit");
7481      return TRUE;
7482    }
7483    res->rtyp=POLY_CMD;
7484    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7485                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7486    return FALSE;
7487  }
7488  else
7489  {
7490    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7491    return TRUE;
7492  }
7493}
7494static BOOLEAN jjREDUCE5(leftv res, leftv u)
7495{
7496  leftv u1=u;
7497  leftv u2=u1->next;
7498  leftv u3=u2->next;
7499  leftv u4=u3->next;
7500  leftv u5=u4->next;
7501  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7502     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7503  {
7504    assumeStdFlag(u3);
7505    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7506    {
7507      WerrorS("2nd argument must be a diagonal matrix of units");
7508      return TRUE;
7509    }
7510    res->rtyp=IDEAL_CMD;
7511    res->data=(char*)redNF(
7512                           idCopy((ideal)u3->Data()),
7513                           idCopy((ideal)u1->Data()),
7514                           mp_Copy((matrix)u2->Data(),currRing),
7515                           (int)(long)u4->Data(),
7516                           (intvec*)u5->Data()
7517                          );
7518    return FALSE;
7519  }
7520  else
7521  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7522     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7523  {
7524    assumeStdFlag(u3);
7525    if(!pIsUnit((poly)u2->Data()))
7526    {
7527      WerrorS("2nd argument must be a unit");
7528      return TRUE;
7529    }
7530    res->rtyp=POLY_CMD;
7531    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7532                           pCopy((poly)u2->Data()),
7533                           (int)(long)u4->Data(),(intvec*)u5->Data());
7534    return FALSE;
7535  }
7536  else
7537  {
7538    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7539           Tok2Cmdname(iiOp));
7540    return TRUE;
7541  }
7542}
7543static BOOLEAN jjRESERVED0(leftv, leftv)
7544{
7545  int i=1;
7546  int nCount = (sArithBase.nCmdUsed-1)/3;
7547  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7548  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7549  //      sArithBase.nCmdAllocated);
7550  for(i=0; i<nCount; i++)
7551  {
7552    Print("%-20s",sArithBase.sCmds[i+1].name);
7553    if(i+1+nCount<sArithBase.nCmdUsed)
7554      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7555    if(i+1+2*nCount<sArithBase.nCmdUsed)
7556      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7557    //if ((i%3)==1) PrintLn();
7558    PrintLn();
7559  }
7560  PrintLn();
7561  printBlackboxTypes();
7562  return FALSE;
7563}
7564static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7565{
7566  if (v == NULL)
7567  {
7568    res->data = omStrDup("");
7569    return FALSE;
7570  }
7571  int n = v->listLength();
7572  if (n == 1)
7573  {
7574    res->data = v->String();
7575    return FALSE;
7576  }
7577
7578  char** slist = (char**) omAlloc(n*sizeof(char*));
7579  int i, j;
7580
7581  for (i=0, j=0; i<n; i++, v = v ->next)
7582  {
7583    slist[i] = v->String();
7584    assume(slist[i] != NULL);
7585    j+=strlen(slist[i]);
7586  }
7587  char* s = (char*) omAlloc((j+1)*sizeof(char));
7588  *s='\0';
7589  for (i=0;i<n;i++)
7590  {
7591    strcat(s, slist[i]);
7592    omFree(slist[i]);
7593  }
7594  omFreeSize(slist, n*sizeof(char*));
7595  res->data = s;
7596  return FALSE;
7597}
7598static BOOLEAN jjTEST(leftv, leftv v)
7599{
7600  do
7601  {
7602    if (v->Typ()!=INT_CMD)
7603      return TRUE;
7604    test_cmd((int)(long)v->Data());
7605    v=v->next;
7606  }
7607  while (v!=NULL);
7608  return FALSE;
7609}
7610
7611#if defined(__alpha) && !defined(linux)
7612extern "C"
7613{
7614  void usleep(unsigned long usec);
7615};
7616#endif
7617static BOOLEAN jjFactModD_M(leftv res, leftv v)
7618{
7619  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7620     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
7621
7622     valid argument lists:
7623     - (poly h, int d),
7624     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7625     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7626                                                          in list of ring vars,
7627     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7628                                                optional: all 4 optional args
7629     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7630      by singclap_factorize and h(0, y)
7631      has exactly two distinct monic factors [possibly with exponent > 1].)
7632     result:
7633     - list with the two factors f and g such that
7634       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7635
7636  poly h      = NULL;
7637  int  d      =    1;
7638  poly f0     = NULL;
7639  poly g0     = NULL;
7640  int  xIndex =    1;   /* default index if none provided */
7641  int  yIndex =    2;   /* default index if none provided */
7642
7643  leftv u = v; int factorsGiven = 0;
7644  if ((u == NULL) || (u->Typ() != POLY_CMD))
7645  {
7646    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7647    return TRUE;
7648  }
7649  else h = (poly)u->Data();
7650  u = u->next;
7651  if ((u == NULL) || (u->Typ() != INT_CMD))
7652  {
7653    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7654    return TRUE;
7655  }
7656  else d = (int)(long)u->Data();
7657  u = u->next;
7658  if ((u != NULL) && (u->Typ() == POLY_CMD))
7659  {
7660    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7661    {
7662      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7663      return TRUE;
7664    }
7665    else
7666    {
7667      f0 = (poly)u->Data();
7668      g0 = (poly)u->next->Data();
7669      factorsGiven = 1;
7670      u = u->next->next;
7671    }
7672  }
7673  if ((u != NULL) && (u->Typ() == INT_CMD))
7674  {
7675    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7676    {
7677      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7678      return TRUE;
7679    }
7680    else
7681    {
7682      xIndex = (int)(long)u->Data();
7683      yIndex = (int)(long)u->next->Data();
7684      u = u->next->next;
7685    }
7686  }
7687  if (u != NULL)
7688  {
7689    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7690    return TRUE;
7691  }
7692
7693  /* checks for provided arguments */
7694  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7695  {
7696    WerrorS("expected non-constant polynomial argument(s)");
7697    return TRUE;
7698  }
7699  int n = rVar(currRing);
7700  if ((xIndex < 1) || (n < xIndex))
7701  {
7702    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7703    return TRUE;
7704  }
7705  if ((yIndex < 1) || (n < yIndex))
7706  {
7707    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7708    return TRUE;
7709  }
7710  if (xIndex == yIndex)
7711  {
7712    WerrorS("expected distinct indices for variables x and y");
7713    return TRUE;
7714  }
7715
7716  /* computation of f0 and g0 if missing */
7717  if (factorsGiven == 0)
7718  {
7719    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7720    intvec* v = NULL;
7721    ideal i = singclap_factorize(h0, &v, 0,currRing);
7722
7723    ivTest(v);
7724
7725    if (i == NULL) return TRUE;
7726
7727    idTest(i);
7728
7729    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7730    {
7731      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7732      return TRUE;
7733    }
7734    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7735    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7736    idDelete(&i);
7737  }
7738
7739  poly f; poly g;
7740  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7741  lists L = (lists)omAllocBin(slists_bin);
7742  L->Init(2);
7743  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7744  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7745  res->rtyp = LIST_CMD;
7746  res->data = (char*)L;
7747  return FALSE;
7748}
7749static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7750{
7751  if ((v->Typ() != LINK_CMD) ||
7752      (v->next->Typ() != STRING_CMD) ||
7753      (v->next->next->Typ() != STRING_CMD) ||
7754      (v->next->next->next->Typ() != INT_CMD))
7755    return TRUE;
7756  jjSTATUS3(res, v, v->next, v->next->next);
7757#if defined(HAVE_USLEEP)
7758  if (((long) res->data) == 0L)
7759  {
7760    int i_s = (int)(long) v->next->next->next->Data();
7761    if (i_s > 0)
7762    {
7763      usleep((int)(long) v->next->next->next->Data());
7764      jjSTATUS3(res, v, v->next, v->next->next);
7765    }
7766  }
7767#elif defined(HAVE_SLEEP)
7768  if (((int) res->data) == 0)
7769  {
7770    int i_s = (int) v->next->next->next->Data();
7771    if (i_s > 0)
7772    {
7773      si_sleep((is - 1)/1000000 + 1);
7774      jjSTATUS3(res, v, v->next, v->next->next);
7775    }
7776  }
7777#endif
7778  return FALSE;
7779}
7780static BOOLEAN jjSUBST_M(leftv res, leftv u)
7781{
7782  leftv v = u->next; // number of args > 0
7783  if (v==NULL) return TRUE;
7784  leftv w = v->next;
7785  if (w==NULL) return TRUE;
7786  leftv rest = w->next;;
7787
7788  u->next = NULL;
7789  v->next = NULL;
7790  w->next = NULL;
7791  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7792  if ((rest!=NULL) && (!b))
7793  {
7794    sleftv tmp_res;
7795    leftv tmp_next=res->next;
7796    res->next=rest;
7797    memset(&tmp_res,0,sizeof(tmp_res));
7798    b = iiExprArithM(&tmp_res,res,iiOp);
7799    memcpy(res,&tmp_res,sizeof(tmp_res));
7800    res->next=tmp_next;
7801  }
7802  u->next = v;
7803  v->next = w;
7804  // rest was w->next, but is already cleaned
7805  return b;
7806}
7807static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7808{
7809  if ((INPUT->Typ() != MATRIX_CMD) ||
7810      (INPUT->next->Typ() != NUMBER_CMD) ||
7811      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7812      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7813  {
7814    WerrorS("expected (matrix, number, number, number) as arguments");
7815    return TRUE;
7816  }
7817  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7818  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7819                                    (number)(v->Data()),
7820                                    (number)(w->Data()),
7821                                    (number)(x->Data()));
7822  return FALSE;
7823}
7824static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7825{ ideal result;
7826  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7827  leftv v = u->next;  /* one additional polynomial or ideal */
7828  leftv h = v->next;  /* Hilbert vector */
7829  leftv w = h->next;  /* weight vector */
7830  assumeStdFlag(u);
7831  ideal i1=(ideal)(u->Data());
7832  ideal i0;
7833  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7834  || (h->Typ()!=INTVEC_CMD)
7835  || (w->Typ()!=INTVEC_CMD))
7836  {
7837    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7838    return TRUE;
7839  }
7840  intvec *vw=(intvec *)w->Data(); // weights of vars
7841  /* merging std_hilb_w and std_1 */
7842  if (vw->length()!=currRing->N)
7843  {
7844    Werror("%d weights for %d variables",vw->length(),currRing->N);
7845    return TRUE;
7846  }
7847  int r=v->Typ();
7848  BOOLEAN cleanup_i0=FALSE;
7849  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7850  {
7851    i0=idInit(1,i1->rank);
7852    i0->m[0]=(poly)v->Data();
7853    cleanup_i0=TRUE;
7854  }
7855  else if (r==IDEAL_CMD)/* IDEAL */
7856  {
7857    i0=(ideal)v->Data();
7858  }
7859  else
7860  {
7861    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7862    return TRUE;
7863  }
7864  int ii0=idElem(i0);
7865  i1 = idSimpleAdd(i1,i0);
7866  if (cleanup_i0)
7867  {
7868    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7869    idDelete(&i0);
7870  }
7871  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7872  tHomog hom=testHomog;
7873  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7874  if (ww!=NULL)
7875  {
7876    if (!idTestHomModule(i1,currRing->qideal,ww))
7877    {
7878      WarnS("wrong weights");
7879      ww=NULL;
7880    }
7881    else
7882    {
7883      ww=ivCopy(ww);
7884      hom=isHomog;
7885    }
7886  }
7887  BITSET save1;
7888  SI_SAVE_OPT1(save1);
7889  si_opt_1|=Sy_bit(OPT_SB_1);
7890  result=kStd(i1,
7891              currRing->qideal,
7892              hom,
7893              &ww,                  // module weights
7894              (intvec *)h->Data(),  // hilbert series
7895              0,                    // syzComp, whatever it is...
7896              IDELEMS(i1)-ii0,      // new ideal
7897              vw);                  // weights of vars
7898  SI_RESTORE_OPT1(save1);
7899  idDelete(&i1);
7900  idSkipZeroes(result);
7901  res->data = (char *)result;
7902  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7903  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7904  return FALSE;
7905}
7906
7907
7908static Subexpr jjMakeSub(leftv e)
7909{
7910  assume( e->Typ()==INT_CMD );
7911  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7912  r->start =(int)(long)e->Data();
7913  return r;
7914}
7915#define D(A)    (A)
7916#define NULL_VAL NULL
7917#define IPARITH
7918#include "table.h"
7919
7920#include "iparith.inc"
7921
7922/*=================== operations with 2 args. ============================*/
7923/* must be ordered: first operations for chars (infix ops),
7924 * then alphabetically */
7925
7926static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
7927                                    BOOLEAN proccall,
7928                                    struct sValCmd2* dA2,
7929                                    int at, int bt,
7930                                    struct sConvertTypes *dConvertTypes)
7931{
7932  memset(res,0,sizeof(sleftv));
7933  BOOLEAN call_failed=FALSE;
7934
7935  if (!errorreported)
7936  {
7937    int i=0;
7938    iiOp=op;
7939    while (dA2[i].cmd==op)
7940    {
7941      if ((at==dA2[i].arg1)
7942      && (bt==dA2[i].arg2))
7943      {
7944        res->rtyp=dA2[i].res;
7945        if (currRing!=NULL)
7946        {
7947          if (check_valid(dA2[i].valid_for,op)) break;
7948        }
7949        else
7950        {
7951          if (RingDependend(dA2[i].res))
7952          {
7953            WerrorS("no ring active");
7954            break;
7955          }
7956        }
7957        if (traceit&TRACE_CALL)
7958          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7959        if ((call_failed=dA2[i].p(res,a,b)))
7960        {
7961          break;// leave loop, goto error handling
7962        }
7963        a->CleanUp();
7964        b->CleanUp();
7965        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7966        return FALSE;
7967      }
7968      i++;
7969    }
7970    // implicite type conversion ----------------------------------------------
7971    if (dA2[i].cmd!=op)
7972    {
7973      int ai,bi;
7974      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7975      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7976      BOOLEAN failed=FALSE;
7977      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7978      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7979      while (dA2[i].cmd==op)
7980      {
7981        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
7982        if ((ai=iiTestConvert(at,dA2[i].arg1))!=0)
7983        {
7984          if ((bi=iiTestConvert(bt,dA2[i].arg2))!=0)
7985          {
7986            res->rtyp=dA2[i].res;
7987            if (currRing!=NULL)
7988            {
7989              if (check_valid(dA2[i].valid_for,op)) break;
7990            }
7991            else
7992            {
7993              if (RingDependend(dA2[i].res))
7994              {
7995                WerrorS("no ring active");
7996                break;
7997              }
7998            }
7999            if (traceit&TRACE_CALL)
8000              Print("call %s(%s,%s)\n",iiTwoOps(op),
8001              Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8002            failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8003            || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8004            || (call_failed=dA2[i].p(res,an,bn)));
8005            // everything done, clean up temp. variables
8006            if (failed)
8007            {
8008              // leave loop, goto error handling
8009              break;
8010            }
8011            else
8012            {
8013              // everything ok, clean up and return
8014              an->CleanUp();
8015              bn->CleanUp();
8016              omFreeBin((ADDRESS)an, sleftv_bin);
8017              omFreeBin((ADDRESS)bn, sleftv_bin);
8018              a->CleanUp();
8019              b->CleanUp();
8020              return FALSE;
8021            }
8022          }
8023        }
8024        i++;
8025      }
8026      an->CleanUp();
8027      bn->CleanUp();
8028      omFreeBin((ADDRESS)an, sleftv_bin);
8029      omFreeBin((ADDRESS)bn, sleftv_bin);
8030    }
8031    // error handling ---------------------------------------------------
8032    const char *s=NULL;
8033    if (!errorreported)
8034    {
8035      if ((at==0) && (a->Fullname()!=sNoName))
8036      {
8037        s=a->Fullname();
8038      }
8039      else if ((bt==0) && (b->Fullname()!=sNoName))
8040      {
8041        s=b->Fullname();
8042      }
8043      if (s!=NULL)
8044        Werror("`%s` is not defined",s);
8045      else
8046      {
8047        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8048        s = iiTwoOps(op);
8049        if (proccall)
8050        {
8051          Werror("%s(`%s`,`%s`) failed"
8052                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8053        }
8054        else
8055        {
8056          Werror("`%s` %s `%s` failed"
8057                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8058        }
8059        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8060        {
8061          while (dA2[i].cmd==op)
8062          {
8063            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8064            && (dA2[i].res!=0)
8065            && (dA2[i].p!=jjWRONG2))
8066            {
8067              if (proccall)
8068                Werror("expected %s(`%s`,`%s`)"
8069                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8070              else
8071                Werror("expected `%s` %s `%s`"
8072                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8073            }
8074            i++;
8075          }
8076        }
8077      }
8078    }
8079    res->rtyp = UNKNOWN;
8080  }
8081  a->CleanUp();
8082  b->CleanUp();
8083  return TRUE;
8084}
8085BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8086                                    struct sValCmd2* dA2,
8087                                    int at,
8088                                    struct sConvertTypes *dConvertTypes)
8089{
8090  leftv b=a->next;
8091  a->next=NULL;
8092  int bt=b->Typ();
8093  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8094  a->next=b;
8095  a->CleanUp();
8096  return bo;
8097}
8098BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8099{
8100  memset(res,0,sizeof(sleftv));
8101  BOOLEAN call_failed=FALSE;
8102
8103  if (!errorreported)
8104  {
8105#ifdef SIQ
8106    if (siq>0)
8107    {
8108      //Print("siq:%d\n",siq);
8109      command d=(command)omAlloc0Bin(sip_command_bin);
8110      memcpy(&d->arg1,a,sizeof(sleftv));
8111      //a->Init();
8112      memcpy(&d->arg2,b,sizeof(sleftv));
8113      //b->Init();
8114      d->argc=2;
8115      d->op=op;
8116      res->data=(char *)d;
8117      res->rtyp=COMMAND;
8118      return FALSE;
8119    }
8120#endif
8121    int at=a->Typ();
8122    int bt=b->Typ();
8123    // handling bb-objects ----------------------------------------------------
8124    if (at>MAX_TOK)
8125    {
8126      blackbox *bb=getBlackboxStuff(at);
8127      if (bb!=NULL)
8128      {
8129        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8130        if (errorreported) return TRUE;
8131        // else: no op defined
8132      }
8133      else          return TRUE;
8134    }
8135    else if ((bt>MAX_TOK)&&(op!='('))
8136    {
8137      blackbox *bb=getBlackboxStuff(bt);
8138      if (bb!=NULL)
8139      {
8140        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8141        if (errorreported) return TRUE;
8142        // else: no op defined
8143      }
8144      else          return TRUE;
8145    }
8146    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8147    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8148  }
8149  a->CleanUp();
8150  b->CleanUp();
8151  return TRUE;
8152}
8153
8154/*==================== operations with 1 arg. ===============================*/
8155/* must be ordered: first operations for chars (infix ops),
8156 * then alphabetically */
8157
8158BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, struct sValCmd1* dA1, int at, struct sConvertTypes *dConvertTypes)
8159{
8160  memset(res,0,sizeof(sleftv));
8161  BOOLEAN call_failed=FALSE;
8162
8163  if (!errorreported)
8164  {
8165    BOOLEAN failed=FALSE;
8166    iiOp=op;
8167    int i = 0;
8168    while (dA1[i].cmd==op)
8169    {
8170      if (at==dA1[i].arg)
8171      {
8172        if (currRing!=NULL)
8173        {
8174          if (check_valid(dA1[i].valid_for,op)) break;
8175        }
8176        else
8177        {
8178          if (RingDependend(dA1[i].res))
8179          {
8180            WerrorS("no ring active");
8181            break;
8182          }
8183        }
8184        if (traceit&TRACE_CALL)
8185          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8186        res->rtyp=dA1[i].res;
8187        if ((call_failed=dA1[i].p(res,a)))
8188        {
8189          break;// leave loop, goto error handling
8190        }
8191        if (a->Next()!=NULL)
8192        {
8193          res->next=(leftv)omAllocBin(sleftv_bin);
8194          failed=iiExprArith1(res->next,a->next,op);
8195        }
8196        a->CleanUp();
8197        return failed;
8198      }
8199      i++;
8200    }
8201    // implicite type conversion --------------------------------------------
8202    if (dA1[i].cmd!=op)
8203    {
8204      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8205      i=0;
8206      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8207      while (dA1[i].cmd==op)
8208      {
8209        int ai;
8210        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8211        if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8212        {
8213          if (currRing!=NULL)
8214          {
8215            if (check_valid(dA1[i].valid_for,op)) break;
8216          }
8217          else
8218          {
8219            if (RingDependend(dA1[i].res))
8220            {
8221              WerrorS("no ring active");
8222              break;
8223            }
8224          }
8225          if (traceit&TRACE_CALL)
8226            Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8227          res->rtyp=dA1[i].res;
8228          failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8229          || (call_failed=dA1[i].p(res,an)));
8230          // everything done, clean up temp. variables
8231          if (failed)
8232          {
8233            // leave loop, goto error handling
8234            break;
8235          }
8236          else
8237          {
8238            if (an->Next() != NULL)
8239            {
8240              res->next = (leftv)omAllocBin(sleftv_bin);
8241              failed=iiExprArith1(res->next,an->next,op);
8242            }
8243            // everything ok, clean up and return
8244            an->CleanUp();
8245            omFreeBin((ADDRESS)an, sleftv_bin);
8246            a->CleanUp();
8247            return failed;
8248          }
8249        }
8250        i++;
8251      }
8252      an->CleanUp();
8253      omFreeBin((ADDRESS)an, sleftv_bin);
8254    }
8255    // error handling
8256    if (!errorreported)
8257    {
8258      if ((at==0) && (a->Fullname()!=sNoName))
8259      {
8260        Werror("`%s` is not defined",a->Fullname());
8261      }
8262      else
8263      {
8264        i=0;
8265        const char *s = iiTwoOps(op);
8266        Werror("%s(`%s`) failed"
8267                ,s,Tok2Cmdname(at));
8268        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8269        {
8270          while (dA1[i].cmd==op)
8271          {
8272            if ((dA1[i].res!=0)
8273            && (dA1[i].p!=jjWRONG))
8274              Werror("expected %s(`%s`)"
8275                ,s,Tok2Cmdname(dA1[i].arg));
8276            i++;
8277          }
8278        }
8279      }
8280    }
8281    res->rtyp = UNKNOWN;
8282  }
8283  a->CleanUp();
8284  return TRUE;
8285}
8286BOOLEAN iiExprArith1(leftv res, leftv a, int op)
8287{
8288  memset(res,0,sizeof(sleftv));
8289  BOOLEAN call_failed=FALSE;
8290
8291  if (!errorreported)
8292  {
8293#ifdef SIQ
8294    if (siq>0)
8295    {
8296      //Print("siq:%d\n",siq);
8297      command d=(command)omAlloc0Bin(sip_command_bin);
8298      memcpy(&d->arg1,a,sizeof(sleftv));
8299      //a->Init();
8300      d->op=op;
8301      d->argc=1;
8302      res->data=(char *)d;
8303      res->rtyp=COMMAND;
8304      return FALSE;
8305    }
8306#endif
8307    int at=a->Typ();
8308    // handling bb-objects ----------------------------------------------------
8309    if (at>MAX_TOK)
8310    {
8311      blackbox *bb=getBlackboxStuff(at);
8312      if (bb!=NULL)
8313      {
8314        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
8315        if (errorreported) return TRUE;
8316        // else: no op defined
8317      }
8318      else          return TRUE;
8319    }
8320
8321    BOOLEAN failed=FALSE;
8322    iiOp=op;
8323    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8324    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
8325  }
8326  a->CleanUp();
8327  return TRUE;
8328}
8329
8330/*=================== operations with 3 args. ============================*/
8331/* must be ordered: first operations for chars (infix ops),
8332 * then alphabetically */
8333
8334static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
8335  struct sValCmd3* dA3, int at, int bt, int ct,
8336  struct sConvertTypes *dConvertTypes)
8337{
8338  memset(res,0,sizeof(sleftv));
8339  BOOLEAN call_failed=FALSE;
8340
8341  assume(dA3[0].cmd==op);
8342
8343  if (!errorreported)
8344  {
8345    int i=0;
8346    iiOp=op;
8347    while (dA3[i].cmd==op)
8348    {
8349      if ((at==dA3[i].arg1)
8350      && (bt==dA3[i].arg2)
8351      && (ct==dA3[i].arg3))
8352      {
8353        res->rtyp=dA3[i].res;
8354        if (currRing!=NULL)
8355        {
8356          if (check_valid(dA3[i].valid_for,op)) break;
8357        }
8358        if (traceit&TRACE_CALL)
8359          Print("call %s(%s,%s,%s)\n",
8360            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8361        if ((call_failed=dA3[i].p(res,a,b,c)))
8362        {
8363          break;// leave loop, goto error handling
8364        }
8365        a->CleanUp();
8366        b->CleanUp();
8367        c->CleanUp();
8368        return FALSE;
8369      }
8370      i++;
8371    }
8372    // implicite type conversion ----------------------------------------------
8373    if (dA3[i].cmd!=op)
8374    {
8375      int ai,bi,ci;
8376      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8377      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8378      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8379      BOOLEAN failed=FALSE;
8380      i=0;
8381      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8382      while (dA3[i].cmd==op)
8383      {
8384        if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
8385        {
8386          if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
8387          {
8388            if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
8389            {
8390              res->rtyp=dA3[i].res;
8391              if (currRing!=NULL)
8392              {
8393                if (check_valid(dA3[i].valid_for,op)) break;
8394              }
8395              if (traceit&TRACE_CALL)
8396                Print("call %s(%s,%s,%s)\n",
8397                  iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
8398                  Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
8399              failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
8400                || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
8401                || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
8402                || (call_failed=dA3[i].p(res,an,bn,cn)));
8403              // everything done, clean up temp. variables
8404              if (failed)
8405              {
8406                // leave loop, goto error handling
8407                break;
8408              }
8409              else
8410              {
8411                // everything ok, clean up and return
8412                an->CleanUp();
8413                bn->CleanUp();
8414                cn->CleanUp();
8415                omFreeBin((ADDRESS)an, sleftv_bin);
8416                omFreeBin((ADDRESS)bn, sleftv_bin);
8417                omFreeBin((ADDRESS)cn, sleftv_bin);
8418                a->CleanUp();
8419                b->CleanUp();
8420                c->CleanUp();
8421        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8422                return FALSE;
8423              }
8424            }
8425          }
8426        }
8427        i++;
8428      }
8429      an->CleanUp();
8430      bn->CleanUp();
8431      cn->CleanUp();
8432      omFreeBin((ADDRESS)an, sleftv_bin);
8433      omFreeBin((ADDRESS)bn, sleftv_bin);
8434      omFreeBin((ADDRESS)cn, sleftv_bin);
8435    }
8436    // error handling ---------------------------------------------------
8437    if (!errorreported)
8438    {
8439      const char *s=NULL;
8440      if ((at==0) && (a->Fullname()!=sNoName))
8441      {
8442        s=a->Fullname();
8443      }
8444      else if ((bt==0) && (b->Fullname()!=sNoName))
8445      {
8446        s=b->Fullname();
8447      }
8448      else if ((ct==0) && (c->Fullname()!=sNoName))
8449      {
8450        s=c->Fullname();
8451      }
8452      if (s!=NULL)
8453        Werror("`%s` is not defined",s);
8454      else
8455      {
8456        i=0;
8457        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8458        const char *s = iiTwoOps(op);
8459        Werror("%s(`%s`,`%s`,`%s`) failed"
8460                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8461        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8462        {
8463          while (dA3[i].cmd==op)
8464          {
8465            if(((at==dA3[i].arg1)
8466            ||(bt==dA3[i].arg2)
8467            ||(ct==dA3[i].arg3))
8468            && (dA3[i].res!=0))
8469            {
8470              Werror("expected %s(`%s`,`%s`,`%s`)"
8471                  ,s,Tok2Cmdname(dA3[i].arg1)
8472                  ,Tok2Cmdname(dA3[i].arg2)
8473                  ,Tok2Cmdname(dA3[i].arg3));
8474            }
8475            i++;
8476          }
8477        }
8478      }
8479    }
8480    res->rtyp = UNKNOWN;
8481  }
8482  a->CleanUp();
8483  b->CleanUp();
8484  c->CleanUp();
8485        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8486  return TRUE;
8487}
8488BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8489{
8490  memset(res,0,sizeof(sleftv));
8491
8492  if (!errorreported)
8493  {
8494#ifdef SIQ
8495    if (siq>0)
8496    {
8497      //Print("siq:%d\n",siq);
8498      command d=(command)omAlloc0Bin(sip_command_bin);
8499      memcpy(&d->arg1,a,sizeof(sleftv));
8500      //a->Init();
8501      memcpy(&d->arg2,b,sizeof(sleftv));
8502      //b->Init();
8503      memcpy(&d->arg3,c,sizeof(sleftv));
8504      //c->Init();
8505      d->op=op;
8506      d->argc=3;
8507      res->data=(char *)d;
8508      res->rtyp=COMMAND;
8509      return FALSE;
8510    }
8511#endif
8512    int at=a->Typ();
8513    // handling bb-objects ----------------------------------------------
8514    if (at>MAX_TOK)
8515    {
8516      blackbox *bb=getBlackboxStuff(at);
8517      if (bb!=NULL)
8518      {
8519        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8520        if (errorreported) return TRUE;
8521        // else: no op defined
8522      }
8523      else          return TRUE;
8524      if (errorreported) return TRUE;
8525    }
8526    int bt=b->Typ();
8527    int ct=c->Typ();
8528
8529    iiOp=op;
8530    int i=0;
8531    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8532    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8533  }
8534  a->CleanUp();
8535  b->CleanUp();
8536  c->CleanUp();
8537        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8538  return TRUE;
8539}
8540BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
8541                                    struct sValCmd3* dA3,
8542                                    int at,
8543                                    struct sConvertTypes *dConvertTypes)
8544{
8545  leftv b=a->next;
8546  a->next=NULL;
8547  int bt=b->Typ();
8548  leftv c=b->next;
8549  b->next=NULL;
8550  int ct=c->Typ();
8551  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8552  b->next=c;
8553  a->next=b;
8554  a->CleanUp();
8555  return bo;
8556}
8557/*==================== operations with many arg. ===============================*/
8558/* must be ordered: first operations for chars (infix ops),
8559 * then alphabetically */
8560
8561BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8562{
8563  // cnt = 0: all
8564  // cnt = 1: only first one
8565  leftv next;
8566  BOOLEAN failed = TRUE;
8567  if(v==NULL) return failed;
8568  res->rtyp = LIST_CMD;
8569  if(cnt) v->next = NULL;
8570  next = v->next;             // saving next-pointer
8571  failed = jjLIST_PL(res, v);
8572  v->next = next;             // writeback next-pointer
8573  return failed;
8574}
8575
8576BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8577{
8578  memset(res,0,sizeof(sleftv));
8579
8580  if (!errorreported)
8581  {
8582#ifdef SIQ
8583    if (siq>0)
8584    {
8585      //Print("siq:%d\n",siq);
8586      command d=(command)omAlloc0Bin(sip_command_bin);
8587      d->op=op;
8588      res->data=(char *)d;
8589      if (a!=NULL)
8590      {
8591        d->argc=a->listLength();
8592        // else : d->argc=0;
8593        memcpy(&d->arg1,a,sizeof(sleftv));
8594        switch(d->argc)
8595        {
8596          case 3:
8597            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8598            a->next->next->Init();
8599            /* no break */
8600          case 2:
8601            memcpy(&d->arg2,a->next,sizeof(sleftv));
8602            a->next->Init();
8603            a->next->next=d->arg2.next;
8604            d->arg2.next=NULL;
8605            /* no break */
8606          case 1:
8607            a->Init();
8608            a->next=d->arg1.next;
8609            d->arg1.next=NULL;
8610        }
8611        if (d->argc>3) a->next=NULL;
8612        a->name=NULL;
8613        a->rtyp=0;
8614        a->data=NULL;
8615        a->e=NULL;
8616        a->attribute=NULL;
8617        a->CleanUp();
8618      }
8619      res->rtyp=COMMAND;
8620      return FALSE;
8621    }
8622#endif
8623    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8624    {
8625      blackbox *bb=getBlackboxStuff(a->Typ());
8626      if (bb!=NULL)
8627      {
8628        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
8629        if (errorreported) return TRUE;
8630        // else: no op defined
8631      }
8632      else          return TRUE;
8633    }
8634    BOOLEAN failed=FALSE;
8635    int args=0;
8636    if (a!=NULL) args=a->listLength();
8637
8638    iiOp=op;
8639    int i=0;
8640    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8641    while (dArithM[i].cmd==op)
8642    {
8643      if ((args==dArithM[i].number_of_args)
8644      || (dArithM[i].number_of_args==-1)
8645      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8646      {
8647        res->rtyp=dArithM[i].res;
8648        if (currRing!=NULL)
8649        {
8650          if (check_valid(dArithM[i].valid_for,op)) break;
8651        }
8652        if (traceit&TRACE_CALL)
8653          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8654        if ((failed=dArithM[i].p(res,a))==TRUE)
8655        {
8656          break;// leave loop, goto error handling
8657        }
8658        if (a!=NULL) a->CleanUp();
8659        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8660        return failed;
8661      }
8662      i++;
8663    }
8664    // error handling
8665    if (!errorreported)
8666    {
8667      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8668      {
8669        Werror("`%s` is not defined",a->Fullname());
8670      }
8671      else
8672      {
8673        const char *s = iiTwoOps(op);
8674        Werror("%s(...) failed",s);
8675      }
8676    }
8677    res->rtyp = UNKNOWN;
8678  }
8679  if (a!=NULL) a->CleanUp();
8680        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8681  return TRUE;
8682}
8683
8684/*=================== general utilities ============================*/
8685int IsCmd(const char *n, int & tok)
8686{
8687  int i;
8688  int an=1;
8689  int en=sArithBase.nLastIdentifier;
8690
8691  loop
8692  //for(an=0; an<sArithBase.nCmdUsed; )
8693  {
8694    if(an>=en-1)
8695    {
8696      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8697      {
8698        i=an;
8699        break;
8700      }
8701      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8702      {
8703        i=en;
8704        break;
8705      }
8706      else
8707      {
8708        // -- blackbox extensions:
8709        // return 0;
8710        return blackboxIsCmd(n,tok);
8711      }
8712    }
8713    i=(an+en)/2;
8714    if (*n < *(sArithBase.sCmds[i].name))
8715    {
8716      en=i-1;
8717    }
8718    else if (*n > *(sArithBase.sCmds[i].name))
8719    {
8720      an=i+1;
8721    }
8722    else
8723    {
8724      int v=strcmp(n,sArithBase.sCmds[i].name);
8725      if(v<0)
8726      {
8727        en=i-1;
8728      }
8729      else if(v>0)
8730      {
8731        an=i+1;
8732      }
8733      else /*v==0*/
8734      {
8735        break;
8736      }
8737    }
8738  }
8739  lastreserved=sArithBase.sCmds[i].name;
8740  tok=sArithBase.sCmds[i].tokval;
8741  if(sArithBase.sCmds[i].alias==2)
8742  {
8743    Warn("outdated identifier `%s` used - please change your code",
8744    sArithBase.sCmds[i].name);
8745    sArithBase.sCmds[i].alias=1;
8746  }
8747  #if 0
8748  if (currRingHdl==NULL)
8749  {
8750    #ifdef SIQ
8751    if (siq<=0)
8752    {
8753    #endif
8754      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8755      {
8756        WerrorS("no ring active");
8757        return 0;
8758      }
8759    #ifdef SIQ
8760    }
8761    #endif
8762  }
8763  #endif
8764  if (!expected_parms)
8765  {
8766    switch (tok)
8767    {
8768      case IDEAL_CMD:
8769      case INT_CMD:
8770      case INTVEC_CMD:
8771      case MAP_CMD:
8772      case MATRIX_CMD:
8773      case MODUL_CMD:
8774      case POLY_CMD:
8775      case PROC_CMD:
8776      case RING_CMD:
8777      case STRING_CMD:
8778        cmdtok = tok;
8779        break;
8780    }
8781  }
8782  return sArithBase.sCmds[i].toktype;
8783}
8784static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8785{
8786  // user defined types are not in the pre-computed table:
8787  if (op>MAX_TOK) return 0;
8788
8789  int a=0;
8790  int e=len;
8791  int p=len/2;
8792  do
8793  {
8794     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8795     if (op<dArithTab[p].cmd) e=p-1;
8796     else   a = p+1;
8797     p=a+(e-a)/2;
8798  }
8799  while ( a <= e);
8800
8801  // catch missing a cmd:
8802  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
8803  // Print("op %d (%c) unknown",op,op);
8804  return 0;
8805}
8806
8807const char * Tok2Cmdname(int tok)
8808{
8809  if (tok <= 0)
8810  {
8811    return sArithBase.sCmds[0].name;
8812  }
8813  if (tok==ANY_TYPE) return "any_type";
8814  if (tok==COMMAND) return "command";
8815  if (tok==NONE) return "nothing";
8816  //if (tok==IFBREAK) return "if_break";
8817  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8818  //if (tok==ORDER_VECTOR) return "ordering";
8819  //if (tok==REF_VAR) return "ref";
8820  //if (tok==OBJECT) return "object";
8821  //if (tok==PRINT_EXPR) return "print_expr";
8822  if (tok==IDHDL) return "identifier";
8823  if (tok==CRING_CMD) return "(c)ring";
8824  if (tok>MAX_TOK) return getBlackboxName(tok);
8825  int i;
8826  for(i=0; i<sArithBase.nCmdUsed; i++)
8827    //while (sArithBase.sCmds[i].tokval!=0)
8828  {
8829    if ((sArithBase.sCmds[i].tokval == tok)&&
8830        (sArithBase.sCmds[i].alias==0))
8831    {
8832      return sArithBase.sCmds[i].name;
8833    }
8834  }
8835  // try gain for alias/old names:
8836  for(i=0; i<sArithBase.nCmdUsed; i++)
8837  {
8838    if (sArithBase.sCmds[i].tokval == tok)
8839    {
8840      return sArithBase.sCmds[i].name;
8841    }
8842  }
8843  return sArithBase.sCmds[0].name;
8844}
8845
8846
8847/*---------------------------------------------------------------------*/
8848/**
8849 * @brief compares to entry of cmdsname-list
8850
8851 @param[in] a
8852 @param[in] b
8853
8854 @return <ReturnValue>
8855**/
8856/*---------------------------------------------------------------------*/
8857static int _gentable_sort_cmds( const void *a, const void *b )
8858{
8859  cmdnames *pCmdL = (cmdnames*)a;
8860  cmdnames *pCmdR = (cmdnames*)b;
8861
8862  if(a==NULL || b==NULL)             return 0;
8863
8864  /* empty entries goes to the end of the list for later reuse */
8865  if(pCmdL->name==NULL) return 1;
8866  if(pCmdR->name==NULL) return -1;
8867
8868  /* $INVALID$ must come first */
8869  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8870  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8871
8872  /* tokval=-1 are reserved names at the end */
8873  if (pCmdL->tokval==-1)
8874  {
8875    if (pCmdR->tokval==-1)
8876       return strcmp(pCmdL->name, pCmdR->name);
8877    /* pCmdL->tokval==-1, pCmdL goes at the end */
8878    return 1;
8879  }
8880  /* pCmdR->tokval==-1, pCmdR goes at the end */
8881  if(pCmdR->tokval==-1) return -1;
8882
8883  return strcmp(pCmdL->name, pCmdR->name);
8884}
8885
8886/*---------------------------------------------------------------------*/
8887/**
8888 * @brief initialisation of arithmetic structured data
8889
8890 @retval 0 on success
8891
8892**/
8893/*---------------------------------------------------------------------*/
8894int iiInitArithmetic()
8895{
8896  //printf("iiInitArithmetic()\n");
8897  memset(&sArithBase, 0, sizeof(sArithBase));
8898  iiInitCmdName();
8899  /* fix last-identifier */
8900#if 0
8901  /* we expect that gentable allready did every thing */
8902  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8903      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8904    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8905  }
8906#endif
8907  //Print("L=%d\n", sArithBase.nLastIdentifier);
8908
8909  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8910  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8911
8912  //iiArithAddCmd("Top", 0,-1,0);
8913
8914
8915  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8916  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8917  //         sArithBase.sCmds[i].name,
8918  //         sArithBase.sCmds[i].alias,
8919  //         sArithBase.sCmds[i].tokval,
8920  //         sArithBase.sCmds[i].toktype);
8921  //}
8922  //iiArithRemoveCmd("Top");
8923  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8924  //iiArithRemoveCmd("mygcd");
8925  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8926  return 0;
8927}
8928
8929int iiArithFindCmd(const char *szName)
8930{
8931  int an=0;
8932  int i = 0,v = 0;
8933  int en=sArithBase.nLastIdentifier;
8934
8935  loop
8936  //for(an=0; an<sArithBase.nCmdUsed; )
8937  {
8938    if(an>=en-1)
8939    {
8940      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8941      {
8942        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8943        return an;
8944      }
8945      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8946      {
8947        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8948        return en;
8949      }
8950      else
8951      {
8952        //Print("RET- 1\n");
8953        return -1;
8954      }
8955    }
8956    i=(an+en)/2;
8957    if (*szName < *(sArithBase.sCmds[i].name))
8958    {
8959      en=i-1;
8960    }
8961    else if (*szName > *(sArithBase.sCmds[i].name))
8962    {
8963      an=i+1;
8964    }
8965    else
8966    {
8967      v=strcmp(szName,sArithBase.sCmds[i].name);
8968      if(v<0)
8969      {
8970        en=i-1;
8971      }
8972      else if(v>0)
8973      {
8974        an=i+1;
8975      }
8976      else /*v==0*/
8977      {
8978        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8979        return i;
8980      }
8981    }
8982  }
8983  //if(i>=0 && i<sArithBase.nCmdUsed)
8984  //  return i;
8985  //Print("RET-2\n");
8986  return -2;
8987}
8988
8989char *iiArithGetCmd( int nPos )
8990{
8991  if(nPos<0) return NULL;
8992  if(nPos<sArithBase.nCmdUsed)
8993    return sArithBase.sCmds[nPos].name;
8994  return NULL;
8995}
8996
8997int iiArithRemoveCmd(const char *szName)
8998{
8999  int nIndex;
9000  if(szName==NULL) return -1;
9001
9002  nIndex = iiArithFindCmd(szName);
9003  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
9004  {
9005    Print("'%s' not found (%d)\n", szName, nIndex);
9006    return -1;
9007  }
9008  omFree(sArithBase.sCmds[nIndex].name);
9009  sArithBase.sCmds[nIndex].name=NULL;
9010  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9011        (&_gentable_sort_cmds));
9012  sArithBase.nCmdUsed--;
9013
9014  /* fix last-identifier */
9015  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9016      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9017  {
9018    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9019  }
9020  //Print("L=%d\n", sArithBase.nLastIdentifier);
9021  return 0;
9022}
9023
9024int iiArithAddCmd(
9025  const char *szName,
9026  short nAlias,
9027  short nTokval,
9028  short nToktype,
9029  short nPos
9030  )
9031{
9032  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9033  //       nTokval, nToktype, nPos);
9034  if(nPos>=0)
9035  {
9036    // no checks: we rely on a correct generated code in iparith.inc
9037    assume(nPos < sArithBase.nCmdAllocated);
9038    assume(szName!=NULL);
9039    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9040    sArithBase.sCmds[nPos].alias   = nAlias;
9041    sArithBase.sCmds[nPos].tokval  = nTokval;
9042    sArithBase.sCmds[nPos].toktype = nToktype;
9043    sArithBase.nCmdUsed++;
9044    //if(nTokval>0) sArithBase.nLastIdentifier++;
9045  }
9046  else
9047  {
9048    if(szName==NULL) return -1;
9049    int nIndex = iiArithFindCmd(szName);
9050    if(nIndex>=0)
9051    {
9052      Print("'%s' already exists at %d\n", szName, nIndex);
9053      return -1;
9054    }
9055
9056    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9057    {
9058      /* needs to create new slots */
9059      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9060      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9061      if(sArithBase.sCmds==NULL) return -1;
9062      sArithBase.nCmdAllocated++;
9063    }
9064    /* still free slots available */
9065    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9066    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9067    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9068    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9069    sArithBase.nCmdUsed++;
9070
9071    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9072          (&_gentable_sort_cmds));
9073    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9074        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9075    {
9076      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9077    }
9078    //Print("L=%d\n", sArithBase.nLastIdentifier);
9079  }
9080  return 0;
9081}
9082
9083static BOOLEAN check_valid(const int p, const int op)
9084{
9085  #ifdef HAVE_PLURAL
9086  if (rIsPluralRing(currRing))
9087  {
9088    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
9089    {
9090      WerrorS("not implemented for non-commutative rings");
9091      return TRUE;
9092    }
9093    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
9094    {
9095      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
9096      return FALSE;
9097    }
9098    /* else, ALLOW_PLURAL */
9099  }
9100  #endif
9101  #ifdef HAVE_RINGS
9102  if (rField_is_Ring(currRing))
9103  {
9104    if ((p & RING_MASK)==0 /*NO_RING*/)
9105    {
9106      WerrorS("not implemented for rings with rings as coeffients");
9107      return TRUE;
9108    }
9109    /* else ALLOW_RING */
9110    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9111    &&(!rField_is_Domain(currRing)))
9112    {
9113      WerrorS("domain required as coeffients");
9114      return TRUE;
9115    }
9116    /* else ALLOW_ZERODIVISOR */
9117    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9118    {
9119      WarnS("considering the image in Q[...]");
9120    }
9121  }
9122  #endif
9123  return FALSE;
9124}
Note: See TracBrowser for help on using the repository browser.