source: git/Singular/iparith.cc @ fc866f6

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