source: git/Singular/iparith.cc @ c7ae4d

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