source: git/Singular/iparith.cc @ 1e47945

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