source: git/Singular/iparith.cc @ 2305c1

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