source: git/Singular/iparith.cc @ 1438fbb

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