source: git/Singular/iparith.cc @ a070b84

fieker-DuValspielwiese
Last change on this file since a070b84 was d2fc5c5, checked in by Hans Schoenemann <hannes@…>, 8 years ago
removed unused test for QRING_CMD
  • Property mode set to 100644
File size: 227.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8
9
10#include <kernel/mod2.h>
11
12#include <omalloc/omalloc.h>
13
14#include <factory/factory.h>
15
16#include <coeffs/bigintmat.h>
17#include <coeffs/coeffs.h>
18#include <coeffs/numbers.h>
19
20
21#include <misc/options.h>
22#include <misc/intvec.h>
23#include <misc/sirandom.h>
24#include <misc/prime.h>
25
26#include <polys/prCopy.h>
27#include <polys/matpol.h>
28#include <polys/monomials/maps.h>
29#include <polys/coeffrings.h>
30#include <polys/sparsmat.h>
31#include <polys/weight.h>
32#include <polys/ext_fields/transext.h>
33#include <polys/clapsing.h>
34
35#include <kernel/combinatorics/stairc.h>
36#include <kernel/combinatorics/hilb.h>
37
38#include <kernel/linear_algebra/interpolation.h>
39#include <kernel/linear_algebra/linearAlgebra.h>
40#include <kernel/linear_algebra/MinorInterface.h>
41
42#include <kernel/spectrum/GMPrat.h>
43#include <kernel/groebner_walk/walkProc.h>
44#include <kernel/oswrapper/timer.h>
45#include <kernel/fglm/fglm.h>
46
47#include <kernel/GBEngine/kstdfac.h>
48#include <kernel/GBEngine/syz.h>
49#include <kernel/GBEngine/kstd1.h>
50#include <kernel/GBEngine/units.h>
51#include <kernel/GBEngine/tgb.h>
52
53#include <kernel/preimage.h>
54#include <kernel/polys.h>
55#include <kernel/ideals.h>
56
57#include <Singular/mod_lib.h>
58#include <Singular/fevoices.h>
59#include <Singular/tok.h>
60#include <Singular/ipid.h>
61#include <Singular/sdb.h>
62#include <Singular/subexpr.h>
63#include <Singular/lists.h>
64#include <Singular/maps_ip.h>
65
66#include <Singular/ipconv.h>
67#include <Singular/ipprint.h>
68#include <Singular/attrib.h>
69#include <Singular/links/silink.h>
70#include <Singular/misc_ip.h>
71#include <Singular/linearAlgebra_ip.h>
72
73#ifdef SINGULAR_4_1
74#include <Singular/number2.h>
75#endif
76
77#  include <Singular/fglm.h>
78
79#include <Singular/blackbox.h>
80#include <Singular/newstruct.h>
81#include <Singular/ipshell.h>
82//#include <kernel/mpr_inout.h>
83#include <reporter/si_signals.h>
84
85#include <Singular/number2.h>
86
87
88#include <stdlib.h>
89#include <string.h>
90#include <ctype.h>
91#include <stdio.h>
92#include <time.h>
93#include <unistd.h>
94#include <vector>
95
96ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
97
98
99// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
100
101#ifdef HAVE_PLURAL
102  #include <kernel/GBEngine/ratgring.h>
103  #include <kernel/GBEngine/nc.h>
104  #include <polys/nc/nc.h>
105  #include <polys/nc/sca.h>
106  #define  PLURAL_MASK 3
107#else /* HAVE_PLURAL */
108  #define  PLURAL_MASK     0
109#endif /* HAVE_PLURAL */
110
111#ifdef HAVE_RINGS
112  #define RING_MASK        4
113  #define ZERODIVISOR_MASK 8
114#else
115  #define RING_MASK        0
116  #define ZERODIVISOR_MASK 0
117#endif
118#define ALLOW_PLURAL     1
119#define NO_PLURAL        0
120#define COMM_PLURAL      2
121#define ALLOW_RING       4
122#define NO_RING          0
123#define NO_ZERODIVISOR   8
124#define ALLOW_ZERODIVISOR  0
125
126// bit 4 for warning, if used at toplevel
127#define WARN_RING        16
128
129static BOOLEAN check_valid(const int p, const int op);
130
131/*=============== types =====================*/
132struct sValCmdTab
133{
134  short cmd;
135  short start;
136};
137
138typedef sValCmdTab jjValCmdTab[];
139
140struct _scmdnames
141{
142  char *name;
143  short alias;
144  short tokval;
145  short toktype;
146};
147typedef struct _scmdnames cmdnames;
148
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  int nCmdUsed;      /**< number of commands used */
197  int nCmdAllocated; /**< number of commands-slots allocated */
198  int 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 (int 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  int i,j;
1294  for(i=r;i>0;i--)
1295  {
1296    for(j=c;j>0;j--)
1297    {
1298      if (pNext(q)!=NULL)
1299      {
1300        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1301                                           q /*(poly)(v->Data())*/, currRing );
1302      }
1303      else
1304        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1305    }
1306  }
1307  id_Normalize((ideal)mm,currRing);
1308  res->data=(char *)mm;
1309  return FALSE;
1310}
1311static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1312{
1313  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1314  jjEQUAL_REST(res,u,v);
1315  return FALSE;
1316}
1317static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1318{
1319  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1320  jjEQUAL_REST(res,u,v);
1321  return FALSE;
1322}
1323static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1324{
1325  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1326  jjEQUAL_REST(res,u,v);
1327  return FALSE;
1328}
1329static BOOLEAN jjEQUAL_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  int 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) != ul)
2065  {
2066    int mul=si_min(ul,MATCOLS(U));
2067    matrix UU=mpNew(ul,ul);
2068    int 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        int i;
2333        if (par_perm_size!=0)
2334          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
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      int i;
2341      for(i=0;i<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<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 i,e;
2798  BOOLEAN err=FALSE;
2799  for(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(int nfinished = 0; nfinished < 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    Werror("det of %d x %d cmatrix",i,j);
4014    return TRUE;
4015  }
4016  return FALSE;
4017}
4018#endif
4019static BOOLEAN jjDET_I(leftv res, leftv v)
4020{
4021  intvec * m=(intvec*)v->Data();
4022  int i,j;
4023  i=m->rows();j=m->cols();
4024  if(i==j)
4025    res->data = (char *)(long)singclap_det_i(m,currRing);
4026  else
4027  {
4028    Werror("det of %d x %d intmat",i,j);
4029    return TRUE;
4030  }
4031  return FALSE;
4032}
4033static BOOLEAN jjDET_S(leftv res, leftv v)
4034{
4035  ideal I=(ideal)v->Data();
4036  poly p;
4037  if (IDELEMS(I)<1) return TRUE;
4038  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
4039  {
4040    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
4041    p=singclap_det(m,currRing);
4042    idDelete((ideal *)&m);
4043  }
4044  else
4045    p=sm_CallDet(I, currRing);
4046  res->data = (char *)p;
4047  return FALSE;
4048}
4049static BOOLEAN jjDIM(leftv res, leftv v)
4050{
4051  assumeStdFlag(v);
4052  if (rHasMixedOrdering(currRing))
4053  {
4054     Warn("dim(%s) may be wrong because the mixed monomial ordering",v->Name());
4055  }
4056  if (rField_is_Ring(currRing))
4057  {
4058    ideal vid = (ideal)v->Data();
4059    int i = idPosConstant(vid);
4060    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4061    { /* ideal v contains unit; dim = -1 */
4062      res->data = (char *)-1L;
4063      return FALSE;
4064    }
4065    ideal vv = id_Head(vid,currRing);
4066    idSkipZeroes(vv);
4067    int j = idPosConstant(vv);
4068    long d;
4069    if(j == -1)
4070    {
4071      d = (long)scDimInt(vv, currRing->qideal);
4072      if(rField_is_Ring_Z(currRing))
4073        d++;
4074    }
4075    else
4076    {
4077      if(n_IsUnit(pGetCoeff(vv->m[j]),currRing->cf))
4078        d = -1;
4079      else
4080        d = (long)scDimInt(vv, currRing->qideal);
4081    }
4082    //Anne's Idea for std(4,2x) = 0 bug
4083    long dcurr = d;
4084    for(i=0;i<IDELEMS(vv);i++)
4085    {
4086      if(vv->m[i] != NULL && !n_IsUnit(pGetCoeff(vv->m[i]),currRing->cf))
4087      {
4088        ideal vc = idCopy(vv);
4089        poly c = pInit();
4090        pSetCoeff0(c,nCopy(pGetCoeff(vv->m[i])));
4091        idInsertPoly(vc,c);
4092        idSkipZeroes(vc);
4093        for(j = 0;j<IDELEMS(vc)-1;j++)
4094        {
4095          if((vc->m[j]!=NULL)
4096          && (n_DivBy(pGetCoeff(vc->m[j]),pGetCoeff(c),currRing->cf)))
4097          {
4098            pDelete(&vc->m[j]);
4099          }
4100        }
4101        idSkipZeroes(vc);
4102        j = idPosConstant(vc);
4103        if (j != -1) pDelete(&vc->m[j]);
4104        dcurr = (long)scDimInt(vc, currRing->qideal);
4105        // the following assumes the ground rings to be either zero- or one-dimensional
4106        if((j==-1) && rField_is_Ring_Z(currRing))
4107        {
4108          // should also be activated for other euclidean domains as groundfield
4109          dcurr++;
4110        }
4111        idDelete(&vc);
4112      }
4113      if(dcurr > d)
4114          d = dcurr;
4115    }
4116    res->data = (char *)d;
4117    idDelete(&vv);
4118    return FALSE;
4119  }
4120  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4121  return FALSE;
4122}
4123static BOOLEAN jjDUMP(leftv, leftv v)
4124{
4125  si_link l = (si_link)v->Data();
4126  if (slDump(l))
4127  {
4128    const char *s;
4129    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4130    else                            s=sNoName;
4131    Werror("cannot dump to `%s`",s);
4132    return TRUE;
4133  }
4134  else
4135    return FALSE;
4136}
4137static BOOLEAN jjE(leftv res, leftv v)
4138{
4139  res->data = (char *)pOne();
4140  int co=(int)(long)v->Data();
4141  if (co>0)
4142  {
4143    pSetComp((poly)res->data,co);
4144    pSetm((poly)res->data);
4145  }
4146  else WerrorS("argument of gen must be positive");
4147  return (co<=0);
4148}
4149static BOOLEAN jjEXECUTE(leftv, leftv v)
4150{
4151  char * d = (char *)v->Data();
4152  char * s = (char *)omAlloc(strlen(d) + 13);
4153  strcpy( s, (char *)d);
4154  strcat( s, "\n;RETURN();\n");
4155  newBuffer(s,BT_execute);
4156  return yyparse();
4157}
4158static BOOLEAN jjFACSTD(leftv res, leftv v)
4159{
4160  lists L=(lists)omAllocBin(slists_bin);
4161  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4162  {
4163    ideal_list p,h;
4164    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4165    if (h==NULL)
4166    {
4167      L->Init(1);
4168      L->m[0].data=(char *)idInit(1);
4169      L->m[0].rtyp=IDEAL_CMD;
4170    }
4171    else
4172    {
4173      p=h;
4174      int l=0;
4175      while (p!=NULL) { p=p->next;l++; }
4176      L->Init(l);
4177      l=0;
4178      while(h!=NULL)
4179      {
4180        L->m[l].data=(char *)h->d;
4181        L->m[l].rtyp=IDEAL_CMD;
4182        p=h->next;
4183        omFreeSize(h,sizeof(*h));
4184        h=p;
4185        l++;
4186      }
4187    }
4188  }
4189  else
4190  {
4191    WarnS("no factorization implemented");
4192    L->Init(1);
4193    iiExprArith1(&(L->m[0]),v,STD_CMD);
4194  }
4195  res->data=(void *)L;
4196  return FALSE;
4197}
4198static BOOLEAN jjFAC_P(leftv res, leftv u)
4199{
4200  intvec *v=NULL;
4201  singclap_factorize_retry=0;
4202  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4203  if (f==NULL) return TRUE;
4204  ivTest(v);
4205  lists l=(lists)omAllocBin(slists_bin);
4206  l->Init(2);
4207  l->m[0].rtyp=IDEAL_CMD;
4208  l->m[0].data=(void *)f;
4209  l->m[1].rtyp=INTVEC_CMD;
4210  l->m[1].data=(void *)v;
4211  res->data=(void *)l;
4212  return FALSE;
4213}
4214static BOOLEAN jjGETDUMP(leftv, leftv v)
4215{
4216  si_link l = (si_link)v->Data();
4217  if (slGetDump(l))
4218  {
4219    const char *s;
4220    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4221    else                            s=sNoName;
4222    Werror("cannot get dump from `%s`",s);
4223    return TRUE;
4224  }
4225  else
4226    return FALSE;
4227}
4228static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4229{
4230  assumeStdFlag(v);
4231  ideal I=(ideal)v->Data();
4232  res->data=(void *)iiHighCorner(I,0);
4233  return FALSE;
4234}
4235static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4236{
4237  assumeStdFlag(v);
4238  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4239  BOOLEAN delete_w=FALSE;
4240  ideal I=(ideal)v->Data();
4241  int i;
4242  poly p=NULL,po=NULL;
4243  int rk=id_RankFreeModule(I,currRing);
4244  if (w==NULL)
4245  {
4246    w = new intvec(rk);
4247    delete_w=TRUE;
4248  }
4249  for(i=rk;i>0;i--)
4250  {
4251    p=iiHighCorner(I,i);
4252    if (p==NULL)
4253    {
4254      WerrorS("module must be zero-dimensional");
4255      if (delete_w) delete w;
4256      return TRUE;
4257    }
4258    if (po==NULL)
4259    {
4260      po=p;
4261    }
4262    else
4263    {
4264      // now po!=NULL, p!=NULL
4265      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4266      if (d==0)
4267        d=pLmCmp(po,p);
4268      if (d > 0)
4269      {
4270        pDelete(&p);
4271      }
4272      else // (d < 0)
4273      {
4274        pDelete(&po); po=p;
4275      }
4276    }
4277  }
4278  if (delete_w) delete w;
4279  res->data=(void *)po;
4280  return FALSE;
4281}
4282static BOOLEAN jjHILBERT(leftv, leftv v)
4283{
4284  if (rField_is_Ring_Z(currRing))
4285  {
4286    ring origR = currRing;
4287    ring tempR = rCopy(origR);
4288    coeffs new_cf=nInitChar(n_Q,NULL);
4289    nKillChar(tempR->cf);
4290    tempR->cf=new_cf;
4291    rComplete(tempR);
4292    ideal vid = (ideal)v->Data();
4293    rChangeCurrRing(tempR);
4294    ideal vv = idrCopyR(vid, origR, currRing);
4295    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4296    vvAsLeftv.rtyp = IDEAL_CMD;
4297    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4298    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4299    assumeStdFlag(&vvAsLeftv);
4300    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
4301    PrintS("//       performed for generic fibre, that is, over Q\n");
4302    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4303    //scHilbertPoly(vv,currRing->qideal);
4304    hLookSeries(vv,module_w,currRing->qideal);
4305    idDelete(&vv);
4306    rChangeCurrRing(origR);
4307    rDelete(tempR);
4308    return FALSE;
4309  }
4310  assumeStdFlag(v);
4311  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4312  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4313  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4314  return FALSE;
4315}
4316static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4317{
4318  if (rField_is_Ring_Z(currRing))
4319  {
4320    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
4321    PrintS("//       performed for generic fibre, that is, over Q\n");
4322  }
4323  res->data=(void *)hSecondSeries((intvec *)v->Data());
4324  return FALSE;
4325}
4326static BOOLEAN jjHOMOG1(leftv res, leftv v)
4327{
4328  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4329  ideal v_id=(ideal)v->Data();
4330  if (w==NULL)
4331  {
4332    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4333    if (res->data!=NULL)
4334    {
4335      if (v->rtyp==IDHDL)
4336      {
4337        char *s_isHomog=omStrDup("isHomog");
4338        if (v->e==NULL)
4339          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4340        else
4341          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4342      }
4343      else if (w!=NULL) delete w;
4344    } // if res->data==NULL then w==NULL
4345  }
4346  else
4347  {
4348    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4349    if((res->data==NULL) && (v->rtyp==IDHDL))
4350    {
4351      if (v->e==NULL)
4352        atKill((idhdl)(v->data),"isHomog");
4353      else
4354        atKill((idhdl)(v->LData()),"isHomog");
4355    }
4356  }
4357  return FALSE;
4358}
4359static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4360{
4361  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4362  setFlag(res,FLAG_STD);
4363  return FALSE;
4364}
4365static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4366{
4367  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4368  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4369  if (IDELEMS((ideal)mat)==0)
4370  {
4371    idDelete((ideal *)&mat);
4372    mat=(matrix)idInit(1,1);
4373  }
4374  else
4375  {
4376    MATROWS(mat)=1;
4377    mat->rank=1;
4378    idTest((ideal)mat);
4379  }
4380  res->data=(char *)mat;
4381  return FALSE;
4382}
4383static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4384{
4385  map m=(map)v->CopyD(MAP_CMD);
4386  omFree((ADDRESS)m->preimage);
4387  m->preimage=NULL;
4388  ideal I=(ideal)m;
4389  I->rank=1;
4390  res->data=(char *)I;
4391  return FALSE;
4392}
4393static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4394{
4395  if (currRing!=NULL)
4396  {
4397    ring q=(ring)v->Data();
4398    if (rSamePolyRep(currRing, q))
4399    {
4400      if (q->qideal==NULL)
4401        res->data=(char *)idInit(1,1);
4402      else
4403        res->data=(char *)idCopy(q->qideal);
4404      return FALSE;
4405    }
4406  }
4407  WerrorS("can only get ideal from identical qring");
4408  return TRUE;
4409}
4410static BOOLEAN jjIm2Iv(leftv res, leftv v)
4411{
4412  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4413  iv->makeVector();
4414  res->data = iv;
4415  return FALSE;
4416}
4417static BOOLEAN jjIMPART(leftv res, leftv v)
4418{
4419  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4420  return FALSE;
4421}
4422static BOOLEAN jjINDEPSET(leftv res, leftv v)
4423{
4424  assumeStdFlag(v);
4425  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4426  return FALSE;
4427}
4428static BOOLEAN jjINTERRED(leftv res, leftv v)
4429{
4430  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4431  if(rField_is_Ring(currRing))
4432    Warn("interred: this command is experimental over the integers");
4433  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4434  res->data = result;
4435  return FALSE;
4436}
4437static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4438{
4439  res->data = (char *)(long)pVar((poly)v->Data());
4440  return FALSE;
4441}
4442static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4443{
4444  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4445                                                            currRing->N)+1);
4446  return FALSE;
4447}
4448static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4449{
4450  res->data = (char *)0;
4451  return FALSE;
4452}
4453static BOOLEAN jjJACOB_P(leftv res, leftv v)
4454{
4455  ideal i=idInit(currRing->N,1);
4456  int k;
4457  poly p=(poly)(v->Data());
4458  for (k=currRing->N;k>0;k--)
4459  {
4460    i->m[k-1]=pDiff(p,k);
4461  }
4462  res->data = (char *)i;
4463  return FALSE;
4464}
4465static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4466{
4467  if (!nCoeff_is_transExt(currRing->cf))
4468  {
4469    WerrorS("differentiation not defined in the coefficient ring");
4470    return TRUE;
4471  }
4472  number n = (number) u->Data();
4473  number k = (number) v->Data();
4474  res->data = ntDiff(n,k,currRing->cf);
4475  return FALSE;
4476}
4477/*2
4478 * compute Jacobi matrix of a module/matrix
4479 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4480 * where Mt := transpose(M)
4481 * Note that this is consistent with the current conventions for jacob in Singular,
4482 * whereas M2 computes its transposed.
4483 */
4484static BOOLEAN jjJACOB_M(leftv res, leftv a)
4485{
4486  ideal id = (ideal)a->Data();
4487  id = id_Transp(id,currRing);
4488  int W = IDELEMS(id);
4489
4490  ideal result = idInit(W * currRing->N, id->rank);
4491  poly *p = result->m;
4492
4493  for( int v = 1; v <= currRing->N; v++ )
4494  {
4495    poly* q = id->m;
4496    for( int i = 0; i < W; i++, p++, q++ )
4497      *p = pDiff( *q, v );
4498  }
4499  idDelete(&id);
4500
4501  res->data = (char *)result;
4502  return FALSE;
4503}
4504
4505
4506static BOOLEAN jjKBASE(leftv res, leftv v)
4507{
4508  assumeStdFlag(v);
4509  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4510  return FALSE;
4511}
4512static BOOLEAN jjL2R(leftv res, leftv v)
4513{
4514  res->data=(char *)syConvList((lists)v->Data());
4515  if (res->data != NULL)
4516    return FALSE;
4517  else
4518    return TRUE;
4519}
4520static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4521{
4522  poly p=(poly)v->Data();
4523  if (p==NULL)
4524  {
4525    res->data=(char *)nInit(0);
4526  }
4527  else
4528  {
4529    res->data=(char *)nCopy(pGetCoeff(p));
4530  }
4531  return FALSE;
4532}
4533static BOOLEAN jjLEADEXP(leftv res, leftv v)
4534{
4535  poly p=(poly)v->Data();
4536  int s=currRing->N;
4537  if (v->Typ()==VECTOR_CMD) s++;
4538  intvec *iv=new intvec(s);
4539  if (p!=NULL)
4540  {
4541    for(int i = currRing->N;i;i--)
4542    {
4543      (*iv)[i-1]=pGetExp(p,i);
4544    }
4545    if (s!=currRing->N)
4546      (*iv)[currRing->N]=pGetComp(p);
4547  }
4548  res->data=(char *)iv;
4549  return FALSE;
4550}
4551static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4552{
4553  poly p=(poly)v->Data();
4554  if (p == NULL)
4555  {
4556    res->data = (char*) NULL;
4557  }
4558  else
4559  {
4560    poly lm = pLmInit(p);
4561    pSetCoeff(lm, nInit(1));
4562    res->data = (char*) lm;
4563  }
4564  return FALSE;
4565}
4566static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4567{
4568  return jjLOAD((char*)v->Data(),FALSE);
4569}
4570static BOOLEAN jjLISTRING(leftv res, leftv v)
4571{
4572  ring r=rCompose((lists)v->Data());
4573  if (r==NULL) return TRUE;
4574  res->data=(char *)r;
4575  return FALSE;
4576}
4577static BOOLEAN jjPFAC1(leftv res, leftv v)
4578{
4579  /* call method jjPFAC2 with second argument = 0 (meaning that no
4580     valid bound for the prime factors has been given) */
4581  sleftv tmp;
4582  memset(&tmp, 0, sizeof(tmp));
4583  tmp.rtyp = INT_CMD;
4584  return jjPFAC2(res, v, &tmp);
4585}
4586static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4587{
4588  /* computes the LU-decomposition of a matrix M;
4589     i.e., M = P * L * U, where
4590        - P is a row permutation matrix,
4591        - L is in lower triangular form,
4592        - U is in upper row echelon form
4593     Then, we also have P * M = L * U.
4594     A list [P, L, U] is returned. */
4595  matrix mat = (const matrix)v->Data();
4596  if (!idIsConstant((ideal)mat))
4597  {
4598    WerrorS("matrix must be constant");
4599    return TRUE;
4600  }
4601  matrix pMat;
4602  matrix lMat;
4603  matrix uMat;
4604
4605  luDecomp(mat, pMat, lMat, uMat);
4606
4607  lists ll = (lists)omAllocBin(slists_bin);
4608  ll->Init(3);
4609  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4610  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4611  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4612  res->data=(char*)ll;
4613
4614  return FALSE;
4615}
4616static BOOLEAN jjMEMORY(leftv res, leftv v)
4617{
4618  omUpdateInfo();
4619  switch(((int)(long)v->Data()))
4620  {
4621  case 0:
4622    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4623    break;
4624  case 1:
4625    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4626    break;
4627  case 2:
4628    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4629    break;
4630  default:
4631    omPrintStats(stdout);
4632    omPrintInfo(stdout);
4633    omPrintBinStats(stdout);
4634    res->data = (char *)0;
4635    res->rtyp = NONE;
4636  }
4637  return FALSE;
4638  res->data = (char *)0;
4639  return FALSE;
4640}
4641//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4642//{
4643//  return jjMONITOR2(res,v,NULL);
4644//}
4645static BOOLEAN jjMSTD(leftv res, leftv v)
4646{
4647  int t=v->Typ();
4648  ideal r,m;
4649  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4650  lists l=(lists)omAllocBin(slists_bin);
4651  l->Init(2);
4652  l->m[0].rtyp=t;
4653  l->m[0].data=(char *)r;
4654  setFlag(&(l->m[0]),FLAG_STD);
4655  l->m[1].rtyp=t;
4656  l->m[1].data=(char *)m;
4657  res->data=(char *)l;
4658  return FALSE;
4659}
4660static BOOLEAN jjMULT(leftv res, leftv v)
4661{
4662  assumeStdFlag(v);
4663  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4664  return FALSE;
4665}
4666static BOOLEAN jjMINRES_R(leftv res, leftv v)
4667{
4668  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4669
4670  syStrategy tmp=(syStrategy)v->Data();
4671  tmp = syMinimize(tmp); // enrich itself!
4672
4673  res->data=(char *)tmp;
4674
4675  if (weights!=NULL)
4676    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4677
4678  return FALSE;
4679}
4680static BOOLEAN jjN2BI(leftv res, leftv v)
4681{
4682  number n,i; i=(number)v->Data();
4683  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4684  if (nMap!=NULL)
4685    n=nMap(i,currRing->cf,coeffs_BIGINT);
4686  else goto err;
4687  res->data=(void *)n;
4688  return FALSE;
4689err:
4690  WerrorS("cannot convert to bigint"); return TRUE;
4691}
4692static BOOLEAN jjNAMEOF(leftv res, leftv v)
4693{
4694  res->data = (char *)v->name;
4695  if (res->data==NULL) res->data=omStrDup("");
4696  v->name=NULL;
4697  return FALSE;
4698}
4699static BOOLEAN jjNAMES(leftv res, leftv v)
4700{
4701  res->data=ipNameList(((ring)v->Data())->idroot);
4702  return FALSE;
4703}
4704static BOOLEAN jjNAMES_I(leftv res, leftv v)
4705{
4706  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4707  return FALSE;
4708}
4709static BOOLEAN jjNOT(leftv res, leftv v)
4710{
4711  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4712  return FALSE;
4713}
4714static BOOLEAN jjNVARS(leftv res, leftv v)
4715{
4716  res->data = (char *)(long)(((ring)(v->Data()))->N);
4717  return FALSE;
4718}
4719static BOOLEAN jjOpenClose(leftv, leftv v)
4720{
4721  si_link l=(si_link)v->Data();
4722  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4723  else { slPrepClose(l); return slClose(l);}
4724}
4725static BOOLEAN jjORD(leftv res, leftv v)
4726{
4727  poly p=(poly)v->Data();
4728  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4729  return FALSE;
4730}
4731static BOOLEAN jjPAR1(leftv res, leftv v)
4732{
4733  int i=(int)(long)v->Data();
4734  int p=0;
4735  p=rPar(currRing);
4736  if ((0<i) && (i<=p))
4737  {
4738    res->data=(char *)n_Param(i,currRing);
4739  }
4740  else
4741  {
4742    Werror("par number %d out of range 1..%d",i,p);
4743    return TRUE;
4744  }
4745  return FALSE;
4746}
4747static BOOLEAN jjPARDEG(leftv res, leftv v)
4748{
4749  number nn=(number)v->Data();
4750  res->data = (char *)(long)n_ParDeg(nn, currRing);
4751  return FALSE;
4752}
4753static BOOLEAN jjPARSTR1(leftv res, leftv v)
4754{
4755  if (currRing==NULL)
4756  {
4757    WerrorS("no ring active");
4758    return TRUE;
4759  }
4760  int i=(int)(long)v->Data();
4761  int p=0;
4762  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4763    res->data=omStrDup(rParameter(currRing)[i-1]);
4764  else
4765  {
4766    Werror("par number %d out of range 1..%d",i,p);
4767    return TRUE;
4768  }
4769  return FALSE;
4770}
4771static BOOLEAN jjP2BI(leftv res, leftv v)
4772{
4773  poly p=(poly)v->Data();
4774  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4775  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4776  {
4777    WerrorS("poly must be constant");
4778    return TRUE;
4779  }
4780  number i=pGetCoeff(p);
4781  number n;
4782  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4783  if (nMap!=NULL)
4784    n=nMap(i,currRing->cf,coeffs_BIGINT);
4785  else goto err;
4786  res->data=(void *)n;
4787  return FALSE;
4788err:
4789  WerrorS("cannot convert to bigint"); return TRUE;
4790}
4791static BOOLEAN jjP2I(leftv res, leftv v)
4792{
4793  poly p=(poly)v->Data();
4794  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4795  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4796  {
4797    WerrorS("poly must be constant");
4798    return TRUE;
4799  }
4800  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4801  return FALSE;
4802}
4803static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4804{
4805  map mapping=(map)v->Data();
4806  syMake(res,omStrDup(mapping->preimage));
4807  return FALSE;
4808}
4809static BOOLEAN jjPRIME(leftv res, leftv v)
4810{
4811  int i = IsPrime((int)(long)(v->Data()));
4812  res->data = (char *)(long)(i > 1 ? i : 2);
4813  return FALSE;
4814}
4815static BOOLEAN jjPRUNE(leftv res, leftv v)
4816{
4817  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4818  ideal v_id=(ideal)v->Data();
4819  if (w!=NULL)
4820  {
4821    if (!idTestHomModule(v_id,currRing->qideal,w))
4822    {
4823      WarnS("wrong weights");
4824      w=NULL;
4825      // and continue at the non-homog case below
4826    }
4827    else
4828    {
4829      w=ivCopy(w);
4830      intvec **ww=&w;
4831      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4832      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4833      return FALSE;
4834    }
4835  }
4836  res->data = (char *)idMinEmbedding(v_id);
4837  return FALSE;
4838}
4839static BOOLEAN jjP2N(leftv res, leftv v)
4840{
4841  number n;
4842  poly p;
4843  if (((p=(poly)v->Data())!=NULL)
4844  && (pIsConstant(p)))
4845  {
4846    n=nCopy(pGetCoeff(p));
4847  }
4848  else
4849  {
4850    n=nInit(0);
4851  }
4852  res->data = (char *)n;
4853  return FALSE;
4854}
4855static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4856{
4857  char *s= (char *)v->Data();
4858  int i = 1;
4859  for(i=0; i<sArithBase.nCmdUsed; i++)
4860  {
4861    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4862    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4863    {
4864      res->data = (char *)1;
4865      return FALSE;
4866    }
4867  }
4868  //res->data = (char *)0;
4869  return FALSE;
4870}
4871static BOOLEAN jjRANK1(leftv res, leftv v)
4872{
4873  matrix m =(matrix)v->Data();
4874  int rank = luRank(m, 0);
4875  res->data =(char *)(long)rank;
4876  return FALSE;
4877}
4878static BOOLEAN jjREAD(leftv res, leftv v)
4879{
4880  return jjREAD2(res,v,NULL);
4881}
4882static BOOLEAN jjREGULARITY(leftv res, leftv v)
4883{
4884  res->data = (char *)(long)iiRegularity((lists)v->Data());
4885  return FALSE;
4886}
4887static BOOLEAN jjREPART(leftv res, leftv v)
4888{
4889  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4890  return FALSE;
4891}
4892static BOOLEAN jjRINGLIST(leftv res, leftv v)
4893{
4894  ring r=(ring)v->Data();
4895  if (r!=NULL)
4896    res->data = (char *)rDecompose((ring)v->Data());
4897  return (r==NULL)||(res->data==NULL);
4898}
4899#ifdef SINGULAR_4_1
4900static BOOLEAN jjRINGLIST_C(leftv res, leftv v)
4901{
4902  coeffs r=(coeffs)v->Data();
4903  if (r!=NULL)
4904    return rDecompose_CF(res,r);
4905  return TRUE;
4906}
4907static BOOLEAN jjRING_LIST(leftv res, leftv v)
4908{
4909  ring r=(ring)v->Data();
4910  if (r!=NULL)
4911    res->data = (char *)rDecompose_list_cf((ring)v->Data());
4912  return (r==NULL)||(res->data==NULL);
4913}
4914#endif
4915static BOOLEAN jjROWS(leftv res, leftv v)
4916{
4917  ideal i = (ideal)v->Data();
4918  res->data = (char *)i->rank;
4919  return FALSE;
4920}
4921static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4922{
4923  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4924  return FALSE;
4925}
4926static BOOLEAN jjROWS_IV(leftv res, leftv v)
4927{
4928  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4929  return FALSE;
4930}
4931static BOOLEAN jjRPAR(leftv res, leftv v)
4932{
4933  res->data = (char *)(long)rPar(((ring)v->Data()));
4934  return FALSE;
4935}
4936static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4937{
4938#ifdef HAVE_PLURAL
4939  const bool bIsSCA = rIsSCA(currRing);
4940#else
4941  const bool bIsSCA = false;
4942#endif
4943
4944  if ((currRing->qideal!=NULL) && !bIsSCA)
4945  {
4946    WerrorS("qring not supported by slimgb at the moment");
4947    return TRUE;
4948  }
4949  if (rHasLocalOrMixedOrdering_currRing())
4950  {
4951    WerrorS("ordering must be global for slimgb");
4952    return TRUE;
4953  }
4954  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4955  // tHomog hom=testHomog;
4956  ideal u_id=(ideal)u->Data();
4957  if (w!=NULL)
4958  {
4959    if (!idTestHomModule(u_id,currRing->qideal,w))
4960    {
4961      WarnS("wrong weights");
4962      w=NULL;
4963    }
4964    else
4965    {
4966      w=ivCopy(w);
4967      // hom=isHomog;
4968    }
4969  }
4970
4971  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4972  res->data=(char *)t_rep_gb(currRing,
4973    u_id,u_id->rank);
4974  //res->data=(char *)t_rep_gb(currRing, u_id);
4975
4976  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4977  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4978  return FALSE;
4979}
4980static BOOLEAN jjSBA(leftv res, leftv v)
4981{
4982  ideal result;
4983  ideal v_id=(ideal)v->Data();
4984  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4985  tHomog hom=testHomog;
4986  if (w!=NULL)
4987  {
4988    if (!idTestHomModule(v_id,currRing->qideal,w))
4989    {
4990      WarnS("wrong weights");
4991      w=NULL;
4992    }
4993    else
4994    {
4995      hom=isHomog;
4996      w=ivCopy(w);
4997    }
4998  }
4999  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
5000  idSkipZeroes(result);
5001  res->data = (char *)result;
5002  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5003  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5004  return FALSE;
5005}
5006static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
5007{
5008  ideal result;
5009  ideal v_id=(ideal)v->Data();
5010  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5011  tHomog hom=testHomog;
5012  if (w!=NULL)
5013  {
5014    if (!idTestHomModule(v_id,currRing->qideal,w))
5015    {
5016      WarnS("wrong weights");
5017      w=NULL;
5018    }
5019    else
5020    {
5021      hom=isHomog;
5022      w=ivCopy(w);
5023    }
5024  }
5025  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
5026  idSkipZeroes(result);
5027  res->data = (char *)result;
5028  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5029  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5030  return FALSE;
5031}
5032static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
5033{
5034  ideal result;
5035  ideal v_id=(ideal)v->Data();
5036  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5037  tHomog hom=testHomog;
5038  if (w!=NULL)
5039  {
5040    if (!idTestHomModule(v_id,currRing->qideal,w))
5041    {
5042      WarnS("wrong weights");
5043      w=NULL;
5044    }
5045    else
5046    {
5047      hom=isHomog;
5048      w=ivCopy(w);
5049    }
5050  }
5051  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
5052  idSkipZeroes(result);
5053  res->data = (char *)result;
5054  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5055  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5056  return FALSE;
5057}
5058static BOOLEAN jjSTD(leftv res, leftv v)
5059{
5060  ideal result;
5061  ideal v_id=(ideal)v->Data();
5062  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5063  tHomog hom=testHomog;
5064  if (w!=NULL)
5065  {
5066    if (!idTestHomModule(v_id,currRing->qideal,w))
5067    {
5068      WarnS("wrong weights");
5069      w=NULL;
5070    }
5071    else
5072    {
5073      hom=isHomog;
5074      w=ivCopy(w);
5075    }
5076  }
5077  result=kStd(v_id,currRing->qideal,hom,&w);
5078  idSkipZeroes(result);
5079  res->data = (char *)result;
5080  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5081  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5082  return FALSE;
5083}
5084static BOOLEAN jjSort_Id(leftv res, leftv v)
5085{
5086  res->data = (char *)idSort((ideal)v->Data());
5087  return FALSE;
5088}
5089static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5090{
5091  singclap_factorize_retry=0;
5092  intvec *v=NULL;
5093  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5094  if (f==NULL) return TRUE;
5095  ivTest(v);
5096  lists l=(lists)omAllocBin(slists_bin);
5097  l->Init(2);
5098  l->m[0].rtyp=IDEAL_CMD;
5099  l->m[0].data=(void *)f;
5100  l->m[1].rtyp=INTVEC_CMD;
5101  l->m[1].data=(void *)v;
5102  res->data=(void *)l;
5103  return FALSE;
5104}
5105#if 1
5106static BOOLEAN jjSYZYGY(leftv res, leftv v)
5107{
5108  intvec *w=NULL;
5109  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5110  if (w!=NULL) delete w;
5111  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5112  return FALSE;
5113}
5114#else
5115// activate, if idSyz handle module weights correctly !
5116static BOOLEAN jjSYZYGY(leftv res, leftv v)
5117{
5118  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5119  ideal v_id=(ideal)v->Data();
5120  tHomog hom=testHomog;
5121  int add_row_shift=0;
5122  if (w!=NULL)
5123  {
5124    w=ivCopy(w);
5125    add_row_shift=w->min_in();
5126    (*w)-=add_row_shift;
5127    if (idTestHomModule(v_id,currRing->qideal,w))
5128      hom=isHomog;
5129    else
5130    {
5131      //WarnS("wrong weights");
5132      delete w; w=NULL;
5133      hom=testHomog;
5134    }
5135  }
5136  res->data = (char *)idSyzygies(v_id,hom,&w);
5137  if (w!=NULL)
5138  {
5139    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5140  }
5141  return FALSE;
5142}
5143#endif
5144static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5145{
5146  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5147  return FALSE;
5148}
5149static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5150{
5151  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5152  return FALSE;
5153}
5154static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5155{
5156  res->data = (char *)ivTranp((intvec*)(v->Data()));
5157  return FALSE;
5158}
5159#ifdef HAVE_PLURAL
5160static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5161{
5162  ring    r = (ring)a->Data();
5163  //if (rIsPluralRing(r))
5164  if (r->OrdSgn==1)
5165  {
5166    res->data = rOpposite(r);
5167  }
5168  else
5169  {
5170    WarnS("opposite only for global orderings");
5171    res->data = rCopy(r);
5172  }
5173  return FALSE;
5174}
5175static BOOLEAN jjENVELOPE(leftv res, leftv a)
5176{
5177  ring    r = (ring)a->Data();
5178  if (rIsPluralRing(r))
5179  {
5180    ring s = rEnvelope(r);
5181    res->data = s;
5182  }
5183  else  res->data = rCopy(r);
5184  return FALSE;
5185}
5186static BOOLEAN jjTWOSTD(leftv res, leftv a)
5187{
5188  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5189  else  res->data=(ideal)a->CopyD();
5190  setFlag(res,FLAG_STD);
5191  setFlag(res,FLAG_TWOSTD);
5192  return FALSE;
5193}
5194#endif
5195
5196static BOOLEAN jjTYPEOF(leftv res, leftv v)
5197{
5198  int t=(int)(long)v->data;
5199  switch (t)
5200  {
5201    #ifdef SINGULAR_4_1
5202    case CRING_CMD:
5203    #endif
5204    case INT_CMD:
5205    case POLY_CMD:
5206    case VECTOR_CMD:
5207    case STRING_CMD:
5208    case INTVEC_CMD:
5209    case IDEAL_CMD:
5210    case MATRIX_CMD:
5211    case MODUL_CMD:
5212    case MAP_CMD:
5213    case PROC_CMD:
5214    case RING_CMD:
5215    //case QRING_CMD:
5216    case INTMAT_CMD:
5217    case BIGINTMAT_CMD:
5218    case NUMBER_CMD:
5219    #ifdef SINGULAR_4_1
5220    case CNUMBER_CMD:
5221    #endif
5222    case BIGINT_CMD:
5223    case LIST_CMD:
5224    case PACKAGE_CMD:
5225    case LINK_CMD:
5226    case RESOLUTION_CMD:
5227         res->data=omStrDup(Tok2Cmdname(t)); break;
5228    case DEF_CMD:
5229    case NONE:           res->data=omStrDup("none"); break;
5230    default:
5231    {
5232      if (t>MAX_TOK)
5233        res->data=omStrDup(getBlackboxName(t));
5234      else
5235        res->data=omStrDup("?unknown type?");
5236      break;
5237    }
5238  }
5239  return FALSE;
5240}
5241static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5242{
5243  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5244  return FALSE;
5245}
5246static BOOLEAN jjVAR1(leftv res, leftv v)
5247{
5248  int i=(int)(long)v->Data();
5249  if ((0<i) && (i<=currRing->N))
5250  {
5251    poly p=pOne();
5252    pSetExp(p,i,1);
5253    pSetm(p);
5254    res->data=(char *)p;
5255  }
5256  else
5257  {
5258    Werror("var number %d out of range 1..%d",i,currRing->N);
5259    return TRUE;
5260  }
5261  return FALSE;
5262}
5263static BOOLEAN jjVARSTR1(leftv res, leftv v)
5264{
5265  if (currRing==NULL)
5266  {
5267    WerrorS("no ring active");
5268    return TRUE;
5269  }
5270  int i=(int)(long)v->Data();
5271  if ((0<i) && (i<=currRing->N))
5272    res->data=omStrDup(currRing->names[i-1]);
5273  else
5274  {
5275    Werror("var number %d out of range 1..%d",i,currRing->N);
5276    return TRUE;
5277  }
5278  return FALSE;
5279}
5280static BOOLEAN jjVDIM(leftv res, leftv v)
5281{
5282  assumeStdFlag(v);
5283  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5284  return FALSE;
5285}
5286BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5287{
5288// input: u: a list with links of type
5289//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5290// returns: -1:  the read state of all links is eof
5291//          i>0: (at least) u[i] is ready
5292  lists Lforks = (lists)u->Data();
5293  int i = slStatusSsiL(Lforks, -1);
5294  if(i == -2) /* error */
5295  {
5296    return TRUE;
5297  }
5298  res->data = (void*)(long)i;
5299  return FALSE;
5300}
5301BOOLEAN jjWAITALL1(leftv res, leftv u)
5302{
5303// input: u: a list with links of type
5304//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5305// returns: -1: the read state of all links is eof
5306//           1: all links are ready
5307//              (caution: at least one is ready, but some maybe dead)
5308  lists Lforks = (lists)u->CopyD();
5309  int i;
5310  int j = -1;
5311  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5312  {
5313    i = slStatusSsiL(Lforks, -1);
5314    if(i == -2) /* error */
5315    {
5316      return TRUE;
5317    }
5318    if(i == -1)
5319    {
5320      break;
5321    }
5322    j = 1;
5323    Lforks->m[i-1].CleanUp();
5324    Lforks->m[i-1].rtyp=DEF_CMD;
5325    Lforks->m[i-1].data=NULL;
5326  }
5327  res->data = (void*)(long)j;
5328  Lforks->Clean();
5329  return FALSE;
5330}
5331
5332BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5333{
5334  char libnamebuf[256];
5335  lib_types LT = type_of_LIB(s, libnamebuf);
5336
5337#ifdef HAVE_DYNAMIC_LOADING
5338  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5339#endif /* HAVE_DYNAMIC_LOADING */
5340  switch(LT)
5341  {
5342      default:
5343      case LT_NONE:
5344        Werror("%s: unknown type", s);
5345        break;
5346      case LT_NOTFOUND:
5347        Werror("cannot open %s", s);
5348        break;
5349
5350      case LT_SINGULAR:
5351      {
5352        char *plib = iiConvName(s);
5353        idhdl pl = IDROOT->get(plib,0);
5354        if (pl==NULL)
5355        {
5356          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5357          IDPACKAGE(pl)->language = LANG_SINGULAR;
5358          IDPACKAGE(pl)->libname=omStrDup(plib);
5359        }
5360        else if (IDTYP(pl)!=PACKAGE_CMD)
5361        {
5362          Werror("can not create package `%s`",plib);
5363          omFree(plib);
5364          return TRUE;
5365        }
5366        package savepack=currPack;
5367        currPack=IDPACKAGE(pl);
5368        IDPACKAGE(pl)->loaded=TRUE;
5369        char libnamebuf[256];
5370        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5371        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5372        currPack=savepack;
5373        IDPACKAGE(pl)->loaded=(!bo);
5374        return bo;
5375      }
5376      case LT_BUILTIN:
5377        SModulFunc_t iiGetBuiltinModInit(const char*);
5378        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5379      case LT_MACH_O:
5380      case LT_ELF:
5381      case LT_HPUX:
5382#ifdef HAVE_DYNAMIC_LOADING
5383        return load_modules(s, libnamebuf, autoexport);
5384#else /* HAVE_DYNAMIC_LOADING */
5385        WerrorS("Dynamic modules are not supported by this version of Singular");
5386        break;
5387#endif /* HAVE_DYNAMIC_LOADING */
5388  }
5389  return TRUE;
5390}
5391static int WerrorS_dummy_cnt=0;
5392static void WerrorS_dummy(const char *)
5393{
5394  WerrorS_dummy_cnt++;
5395}
5396BOOLEAN jjLOAD_TRY(const char *s)
5397{
5398  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5399  WerrorS_callback=WerrorS_dummy;
5400  WerrorS_dummy_cnt=0;
5401  BOOLEAN bo=jjLOAD(s,TRUE);
5402  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5403    Print("loading of >%s< failed\n",s);
5404  WerrorS_callback=WerrorS_save;
5405  errorreported=0;
5406  return FALSE;
5407}
5408
5409static BOOLEAN jjstrlen(leftv res, leftv v)
5410{
5411  res->data = (char *)strlen((char *)v->Data());
5412  return FALSE;
5413}
5414static BOOLEAN jjpLength(leftv res, leftv v)
5415{
5416  res->data = (char *)(long)pLength((poly)v->Data());
5417  return FALSE;
5418}
5419static BOOLEAN jjidElem(leftv res, leftv v)
5420{
5421  res->data = (char *)(long)idElem((ideal)v->Data());
5422  return FALSE;
5423}
5424static BOOLEAN jjidFreeModule(leftv res, leftv v)
5425{
5426  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5427  return FALSE;
5428}
5429static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5430{
5431  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5432  return FALSE;
5433}
5434static BOOLEAN jjrCharStr(leftv res, leftv v)
5435{
5436  res->data = rCharStr((ring)v->Data());
5437  return FALSE;
5438}
5439static BOOLEAN jjpHead(leftv res, leftv v)
5440{
5441  res->data = (char *)pHead((poly)v->Data());
5442  return FALSE;
5443}
5444static BOOLEAN jjidHead(leftv res, leftv v)
5445{
5446  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5447  setFlag(res,FLAG_STD);
5448  return FALSE;
5449}
5450static BOOLEAN jjidMinBase(leftv res, leftv v)
5451{
5452  res->data = (char *)idMinBase((ideal)v->Data());
5453  return FALSE;
5454}
5455static BOOLEAN jjsyMinBase(leftv res, leftv v)
5456{
5457  res->data = (char *)syMinBase((ideal)v->Data());
5458  return FALSE;
5459}
5460static BOOLEAN jjpMaxComp(leftv res, leftv v)
5461{
5462  res->data = (char *)pMaxComp((poly)v->Data());
5463  return FALSE;
5464}
5465static BOOLEAN jjmpTrace(leftv res, leftv v)
5466{
5467  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5468  return FALSE;
5469}
5470static BOOLEAN jjmpTransp(leftv res, leftv v)
5471{
5472  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5473  return FALSE;
5474}
5475static BOOLEAN jjrOrdStr(leftv res, leftv v)
5476{
5477  res->data = rOrdStr((ring)v->Data());
5478  return FALSE;
5479}
5480static BOOLEAN jjrVarStr(leftv res, leftv v)
5481{
5482  res->data = rVarStr((ring)v->Data());
5483  return FALSE;
5484}
5485static BOOLEAN jjrParStr(leftv res, leftv v)
5486{
5487  res->data = rParStr((ring)v->Data());
5488  return FALSE;
5489}
5490static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5491{
5492  res->data=(char *)(long)sySize((syStrategy)v->Data());
5493  return FALSE;
5494}
5495static BOOLEAN jjDIM_R(leftv res, leftv v)
5496{
5497  res->data = (char *)(long)syDim((syStrategy)v->Data());
5498  return FALSE;
5499}
5500static BOOLEAN jjidTransp(leftv res, leftv v)
5501{
5502  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5503  return FALSE;
5504}
5505static BOOLEAN jjnInt(leftv res, leftv u)
5506{
5507  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5508  res->data=(char *)(long)iin_Int(n,currRing->cf);
5509  n_Delete(&n,currRing->cf);
5510  return FALSE;
5511}
5512static BOOLEAN jjnlInt(leftv res, leftv u)
5513{
5514  number n=(number)u->Data();
5515  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5516  return FALSE;
5517}
5518/*=================== operations with 3 args.: static proc =================*/
5519/* must be ordered: first operations for chars (infix ops),
5520 * then alphabetically */
5521static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5522{
5523  char *s= (char *)u->Data();
5524  int   r = (int)(long)v->Data();
5525  int   c = (int)(long)w->Data();
5526  int l = strlen(s);
5527
5528  if ( (r<1) || (r>l) || (c<0) )
5529  {
5530    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5531    return TRUE;
5532  }
5533  res->data = (char *)omAlloc((long)(c+1));
5534  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5535  return FALSE;
5536}
5537static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5538{
5539  intvec *iv = (intvec *)u->Data();
5540  int   r = (int)(long)v->Data();
5541  int   c = (int)(long)w->Data();
5542  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5543  {
5544    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5545           r,c,u->Fullname(),iv->rows(),iv->cols());
5546    return TRUE;
5547  }
5548  res->data=u->data; u->data=NULL;
5549  res->rtyp=u->rtyp; u->rtyp=0;
5550  res->name=u->name; u->name=NULL;
5551  Subexpr e=jjMakeSub(v);
5552          e->next=jjMakeSub(w);
5553  if (u->e==NULL) res->e=e;
5554  else
5555  {
5556    Subexpr h=u->e;
5557    while (h->next!=NULL) h=h->next;
5558    h->next=e;
5559    res->e=u->e;
5560    u->e=NULL;
5561  }
5562  return FALSE;
5563}
5564static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5565{
5566  bigintmat *bim = (bigintmat *)u->Data();
5567  int   r = (int)(long)v->Data();
5568  int   c = (int)(long)w->Data();
5569  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5570  {
5571    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5572           r,c,u->Fullname(),bim->rows(),bim->cols());
5573    return TRUE;
5574  }
5575  res->data=u->data; u->data=NULL;
5576  res->rtyp=u->rtyp; u->rtyp=0;
5577  res->name=u->name; u->name=NULL;
5578  Subexpr e=jjMakeSub(v);
5579          e->next=jjMakeSub(w);
5580  if (u->e==NULL)
5581    res->e=e;
5582  else
5583  {
5584    Subexpr h=u->e;
5585    while (h->next!=NULL) h=h->next;
5586    h->next=e;
5587    res->e=u->e;
5588    u->e=NULL;
5589  }
5590  return FALSE;
5591}
5592static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5593{
5594  matrix m= (matrix)u->Data();
5595  int   r = (int)(long)v->Data();
5596  int   c = (int)(long)w->Data();
5597  //Print("gen. elem %d, %d\n",r,c);
5598  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5599  {
5600    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5601      MATROWS(m),MATCOLS(m));
5602    return TRUE;
5603  }
5604  res->data=u->data; u->data=NULL;
5605  res->rtyp=u->rtyp; u->rtyp=0;
5606  res->name=u->name; u->name=NULL;
5607  Subexpr e=jjMakeSub(v);
5608          e->next=jjMakeSub(w);
5609  if (u->e==NULL)
5610    res->e=e;
5611  else
5612  {
5613    Subexpr h=u->e;
5614    while (h->next!=NULL) h=h->next;
5615    h->next=e;
5616    res->e=u->e;
5617    u->e=NULL;
5618  }
5619  return FALSE;
5620}
5621static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5622{
5623  sleftv t;
5624  sleftv ut;
5625  leftv p=NULL;
5626  intvec *iv=(intvec *)w->Data();
5627  int l;
5628  BOOLEAN nok;
5629
5630  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5631  {
5632    WerrorS("cannot build expression lists from unnamed objects");
5633    return TRUE;
5634  }
5635  memcpy(&ut,u,sizeof(ut));
5636  memset(&t,0,sizeof(t));
5637  t.rtyp=INT_CMD;
5638  for (l=0;l< iv->length(); l++)
5639  {
5640    t.data=(char *)(long)((*iv)[l]);
5641    if (p==NULL)
5642    {
5643      p=res;
5644    }
5645    else
5646    {
5647      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5648      p=p->next;
5649    }
5650    memcpy(u,&ut,sizeof(ut));
5651    if (u->Typ() == MATRIX_CMD)
5652      nok=jjBRACK_Ma(p,u,v,&t);
5653    else if (u->Typ() == BIGINTMAT_CMD)
5654      nok=jjBRACK_Bim(p,u,v,&t);
5655    else /* INTMAT_CMD */
5656      nok=jjBRACK_Im(p,u,v,&t);
5657    if (nok)
5658    {
5659      while (res->next!=NULL)
5660      {
5661        p=res->next->next;
5662        omFreeBin((ADDRESS)res->next, sleftv_bin);
5663        // res->e aufraeumen !!!!
5664        res->next=p;
5665      }
5666      return TRUE;
5667    }
5668  }
5669  return FALSE;
5670}
5671static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5672{
5673  sleftv t;
5674  sleftv ut;
5675  leftv p=NULL;
5676  intvec *iv=(intvec *)v->Data();
5677  int l;
5678  BOOLEAN nok;
5679
5680  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5681  {
5682    WerrorS("cannot build expression lists from unnamed objects");
5683    return TRUE;
5684  }
5685  memcpy(&ut,u,sizeof(ut));
5686  memset(&t,0,sizeof(t));
5687  t.rtyp=INT_CMD;
5688  for (l=0;l< iv->length(); l++)
5689  {
5690    t.data=(char *)(long)((*iv)[l]);
5691    if (p==NULL)
5692    {
5693      p=res;
5694    }
5695    else
5696    {
5697      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5698      p=p->next;
5699    }
5700    memcpy(u,&ut,sizeof(ut));
5701    if (u->Typ() == MATRIX_CMD)
5702      nok=jjBRACK_Ma(p,u,&t,w);
5703    else if (u->Typ() == BIGINTMAT_CMD)
5704      nok=jjBRACK_Bim(p,u,&t,w);
5705    else /* INTMAT_CMD */
5706      nok=jjBRACK_Im(p,u,&t,w);
5707    if (nok)
5708    {
5709      while (res->next!=NULL)
5710      {
5711        p=res->next->next;
5712        omFreeBin((ADDRESS)res->next, sleftv_bin);
5713        // res->e aufraeumen !!
5714        res->next=p;
5715      }
5716      return TRUE;
5717    }
5718  }
5719  return FALSE;
5720}
5721static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5722{
5723  sleftv t1,t2,ut;
5724  leftv p=NULL;
5725  intvec *vv=(intvec *)v->Data();
5726  intvec *wv=(intvec *)w->Data();
5727  int vl;
5728  int wl;
5729  BOOLEAN nok;
5730
5731  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5732  {
5733    WerrorS("cannot build expression lists from unnamed objects");
5734    return TRUE;
5735  }
5736  memcpy(&ut,u,sizeof(ut));
5737  memset(&t1,0,sizeof(sleftv));
5738  memset(&t2,0,sizeof(sleftv));
5739  t1.rtyp=INT_CMD;
5740  t2.rtyp=INT_CMD;
5741  for (vl=0;vl< vv->length(); vl++)
5742  {
5743    t1.data=(char *)(long)((*vv)[vl]);
5744    for (wl=0;wl< wv->length(); wl++)
5745    {
5746      t2.data=(char *)(long)((*wv)[wl]);
5747      if (p==NULL)
5748      {
5749        p=res;
5750      }
5751      else
5752      {
5753        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5754        p=p->next;
5755      }
5756      memcpy(u,&ut,sizeof(ut));
5757      if (u->Typ() == MATRIX_CMD)
5758        nok=jjBRACK_Ma(p,u,&t1,&t2);
5759      else if (u->Typ() == BIGINTMAT_CMD)
5760        nok=jjBRACK_Bim(p,u,&t1,&t2);
5761      else /* INTMAT_CMD */
5762        nok=jjBRACK_Im(p,u,&t1,&t2);
5763      if (nok)
5764      {
5765        res->CleanUp();
5766        return TRUE;
5767      }
5768    }
5769  }
5770  return FALSE;
5771}
5772static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5773{
5774  v->next=(leftv)omAllocBin(sleftv_bin);
5775  memcpy(v->next,w,sizeof(sleftv));
5776  memset(w,0,sizeof(sleftv));
5777  return jjPROC(res,u,v);
5778}
5779static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5780{
5781  intvec *iv;
5782  ideal m;
5783  lists l=(lists)omAllocBin(slists_bin);
5784  int k=(int)(long)w->Data();
5785  if (k>=0)
5786  {
5787    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5788    l->Init(2);
5789    l->m[0].rtyp=MODUL_CMD;
5790    l->m[1].rtyp=INTVEC_CMD;
5791    l->m[0].data=(void *)m;
5792    l->m[1].data=(void *)iv;
5793  }
5794  else
5795  {
5796    m=sm_CallSolv((ideal)u->Data(), currRing);
5797    l->Init(1);
5798    l->m[0].rtyp=IDEAL_CMD;
5799    l->m[0].data=(void *)m;
5800  }
5801  res->data = (char *)l;
5802  return FALSE;
5803}
5804static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5805{
5806  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5807  {
5808    WerrorS("3rd argument must be a name of a matrix");
5809    return TRUE;
5810  }
5811  ideal i=(ideal)u->Data();
5812  int rank=(int)i->rank;
5813  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5814  if (r) return TRUE;
5815  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5816  return FALSE;
5817}
5818static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5819{
5820  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5821           (ideal)(v->Data()),(poly)(w->Data()));
5822  return FALSE;
5823}
5824static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5825{
5826  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5827  {
5828    WerrorS("3rd argument must be a name of a matrix");
5829    return TRUE;
5830  }
5831  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5832  poly p=(poly)u->CopyD(POLY_CMD);
5833  ideal i=idInit(1,1);
5834  i->m[0]=p;
5835  sleftv t;
5836  memset(&t,0,sizeof(t));
5837  t.data=(char *)i;
5838  t.rtyp=IDEAL_CMD;
5839  int rank=1;
5840  if (u->Typ()==VECTOR_CMD)
5841  {
5842    i->rank=rank=pMaxComp(p);
5843    t.rtyp=MODUL_CMD;
5844  }
5845  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5846  t.CleanUp();
5847  if (r) return TRUE;
5848  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5849  return FALSE;
5850}
5851static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5852{
5853  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5854    (intvec *)w->Data());
5855  //setFlag(res,FLAG_STD);
5856  return FALSE;
5857}
5858static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5859{
5860  /*4
5861  * look for the substring what in the string where
5862  * starting at position n
5863  * return the position of the first char of what in where
5864  * or 0
5865  */
5866  int n=(int)(long)w->Data();
5867  char *where=(char *)u->Data();
5868  char *what=(char *)v->Data();
5869  char *found;
5870  if ((1>n)||(n>(int)strlen(where)))
5871  {
5872    Werror("start position %d out of range",n);
5873    return TRUE;
5874  }
5875  found = strchr(where+n-1,*what);
5876  if (*(what+1)!='\0')
5877  {
5878    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5879    {
5880      found=strchr(found+1,*what);
5881    }
5882  }
5883  if (found != NULL)
5884  {
5885    res->data=(char *)((found-where)+1);
5886  }
5887  return FALSE;
5888}
5889static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5890{
5891  if ((int)(long)w->Data()==0)
5892    res->data=(char *)walkProc(u,v);
5893  else
5894    res->data=(char *)fractalWalkProc(u,v);
5895  setFlag( res, FLAG_STD );
5896  return FALSE;
5897}
5898static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5899{
5900  intvec *wdegree=(intvec*)w->Data();
5901  if (wdegree->length()!=currRing->N)
5902  {
5903    Werror("weight vector must have size %d, not %d",
5904           currRing->N,wdegree->length());
5905    return TRUE;
5906  }
5907  if (rField_is_Ring_Z(currRing))
5908  {
5909    ring origR = currRing;
5910    ring tempR = rCopy(origR);
5911    coeffs new_cf=nInitChar(n_Q,NULL);
5912    nKillChar(tempR->cf);
5913    tempR->cf=new_cf;
5914    rComplete(tempR);
5915    ideal uid = (ideal)u->Data();
5916    rChangeCurrRing(tempR);
5917    ideal uu = idrCopyR(uid, origR, currRing);
5918    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5919    uuAsLeftv.rtyp = IDEAL_CMD;
5920    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5921    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5922    assumeStdFlag(&uuAsLeftv);
5923    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
5924    PrintS("//       performed for generic fibre, that is, over Q\n");
5925    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5926    intvec *iv=hFirstSeries(uu,module_w,currRing->qideal,wdegree);
5927    int returnWithTrue = 1;
5928    switch((int)(long)v->Data())
5929    {
5930      case 1:
5931        res->data=(void *)iv;
5932        returnWithTrue = 0;
5933      case 2:
5934        res->data=(void *)hSecondSeries(iv);
5935        delete iv;
5936        returnWithTrue = 0;
5937    }
5938    if (returnWithTrue)
5939    {
5940      WerrorS(feNotImplemented);
5941      delete iv;
5942    }
5943    idDelete(&uu);
5944    rChangeCurrRing(origR);
5945    rDelete(tempR);
5946    if (returnWithTrue) return TRUE; else return FALSE;
5947  }
5948  assumeStdFlag(u);
5949  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5950  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
5951  switch((int)(long)v->Data())
5952  {
5953    case 1:
5954      res->data=(void *)iv;
5955      return FALSE;
5956    case 2:
5957      res->data=(void *)hSecondSeries(iv);
5958      delete iv;
5959      return FALSE;
5960  }
5961  WerrorS(feNotImplemented);
5962  delete iv;
5963  return TRUE;
5964}
5965static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
5966{
5967  PrintS("TODO\n");
5968  int i=pVar((poly)v->Data());
5969  if (i==0)
5970  {
5971    WerrorS("ringvar expected");
5972    return TRUE;
5973  }
5974  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5975  int d=pWTotaldegree(p);
5976  pLmDelete(p);
5977  if (d==1)
5978    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5979  else
5980    WerrorS("variable must have weight 1");
5981  return (d!=1);
5982}
5983static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
5984{
5985  PrintS("TODO\n");
5986  int i=pVar((poly)v->Data());
5987  if (i==0)
5988  {
5989    WerrorS("ringvar expected");
5990    return TRUE;
5991  }
5992  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5993  int d=pWTotaldegree(p);
5994  pLmDelete(p);
5995  if (d==1)
5996    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5997  else
5998    WerrorS("variable must have weight 1");
5999  return (d!=1);
6000}
6001static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
6002{
6003  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
6004  intvec* arg = (intvec*) u->Data();
6005  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
6006
6007  for (i=0; i<n; i++)
6008  {
6009    (*im)[i] = (*arg)[i];
6010  }
6011
6012  res->data = (char *)im;
6013  return FALSE;
6014}
6015static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
6016{
6017  short *iw=iv2array((intvec *)w->Data(),currRing);
6018  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
6019  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
6020  return FALSE;
6021}
6022static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
6023{
6024  if (!pIsUnit((poly)v->Data()))
6025  {
6026    WerrorS("2nd argument must be a unit");
6027    return TRUE;
6028  }
6029  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
6030  return FALSE;
6031}
6032static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
6033{
6034  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
6035                             (intvec *)w->Data(),currRing);
6036  return FALSE;
6037}
6038static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6039{
6040  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6041  {
6042    WerrorS("2nd argument must be a diagonal matrix of units");
6043    return TRUE;
6044  }
6045  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6046                               (matrix)v->CopyD());
6047  return FALSE;
6048}
6049static BOOLEAN currRingIsOverIntegralDomain ()
6050{
6051  /* true for fields and Z, false otherwise */
6052  if (rField_is_Ring_PtoM(currRing)) return FALSE;
6053  if (rField_is_Ring_2toM(currRing)) return FALSE;
6054  if (rField_is_Ring_ModN(currRing)) return FALSE;
6055  return TRUE;
6056}
6057static BOOLEAN jjMINOR_M(leftv res, leftv v)
6058{
6059  /* Here's the use pattern for the minor command:
6060        minor ( matrix_expression m, int_expression minorSize,
6061                optional ideal_expression IasSB, optional int_expression k,
6062                optional string_expression algorithm,
6063                optional int_expression cachedMinors,
6064                optional int_expression cachedMonomials )
6065     This method here assumes that there are at least two arguments.
6066     - If IasSB is present, it must be a std basis. All minors will be
6067       reduced w.r.t. IasSB.
6068     - If k is absent, all non-zero minors will be computed.
6069       If k is present and k > 0, the first k non-zero minors will be
6070       computed.
6071       If k is present and k < 0, the first |k| minors (some of which
6072       may be zero) will be computed.
6073       If k is present and k = 0, an error is reported.
6074     - If algorithm is absent, all the following arguments must be absent too.
6075       In this case, a heuristic picks the best-suited algorithm (among
6076       Bareiss, Laplace, and Laplace with caching).
6077       If algorithm is present, it must be one of "Bareiss", "bareiss",
6078       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6079       "cache" two more arguments may be given, determining how many entries
6080       the cache may have at most, and how many cached monomials there are at
6081       most. (Cached monomials are counted over all cached polynomials.)
6082       If these two additional arguments are not provided, 200 and 100000
6083       will be used as defaults.
6084  */
6085  matrix m;
6086  leftv u=v->next;
6087  v->next=NULL;
6088  int v_typ=v->Typ();
6089  if (v_typ==MATRIX_CMD)
6090  {
6091     m = (const matrix)v->Data();
6092  }
6093  else
6094  {
6095    if (v_typ==0)
6096    {
6097      Werror("`%s` is undefined",v->Fullname());
6098      return TRUE;
6099    }
6100    // try to convert to MATRIX:
6101    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6102    BOOLEAN bo;
6103    sleftv tmp;
6104    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6105    else bo=TRUE;
6106    if (bo)
6107    {
6108      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6109      return TRUE;
6110    }
6111    m=(matrix)tmp.data;
6112  }
6113  const int mk = (const int)(long)u->Data();
6114  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6115  bool noCacheMinors = true; bool noCacheMonomials = true;
6116  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6117
6118  /* here come the different cases of correct argument sets */
6119  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6120  {
6121    IasSB = (ideal)u->next->Data();
6122    noIdeal = false;
6123    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6124    {
6125      k = (int)(long)u->next->next->Data();
6126      noK = false;
6127      assume(k != 0);
6128      if ((u->next->next->next != NULL) &&
6129          (u->next->next->next->Typ() == STRING_CMD))
6130      {
6131        algorithm = (char*)u->next->next->next->Data();
6132        noAlgorithm = false;
6133        if ((u->next->next->next->next != NULL) &&
6134            (u->next->next->next->next->Typ() == INT_CMD))
6135        {
6136          cacheMinors = (int)(long)u->next->next->next->next->Data();
6137          noCacheMinors = false;
6138          if ((u->next->next->next->next->next != NULL) &&
6139              (u->next->next->next->next->next->Typ() == INT_CMD))
6140          {
6141            cacheMonomials =
6142               (int)(long)u->next->next->next->next->next->Data();
6143            noCacheMonomials = false;
6144          }
6145        }
6146      }
6147    }
6148  }
6149  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6150  {
6151    k = (int)(long)u->next->Data();
6152    noK = false;
6153    assume(k != 0);
6154    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6155    {
6156      algorithm = (char*)u->next->next->Data();
6157      noAlgorithm = false;
6158      if ((u->next->next->next != NULL) &&
6159          (u->next->next->next->Typ() == INT_CMD))
6160      {
6161        cacheMinors = (int)(long)u->next->next->next->Data();
6162        noCacheMinors = false;
6163        if ((u->next->next->next->next != NULL) &&
6164            (u->next->next->next->next->Typ() == INT_CMD))
6165        {
6166          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6167          noCacheMonomials = false;
6168        }
6169      }
6170    }
6171  }
6172  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6173  {
6174    algorithm = (char*)u->next->Data();
6175    noAlgorithm = false;
6176    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6177    {
6178      cacheMinors = (int)(long)u->next->next->Data();
6179      noCacheMinors = false;
6180      if ((u->next->next->next != NULL) &&
6181          (u->next->next->next->Typ() == INT_CMD))
6182      {
6183        cacheMonomials = (int)(long)u->next->next->next->Data();
6184        noCacheMonomials = false;
6185      }
6186    }
6187  }
6188
6189  /* upper case conversion for the algorithm if present */
6190  if (!noAlgorithm)
6191  {
6192    if (strcmp(algorithm, "bareiss") == 0)
6193      algorithm = (char*)"Bareiss";
6194    if (strcmp(algorithm, "laplace") == 0)
6195      algorithm = (char*)"Laplace";
6196    if (strcmp(algorithm, "cache") == 0)
6197      algorithm = (char*)"Cache";
6198  }
6199
6200  v->next=u;
6201  /* here come some tests */
6202  if (!noIdeal)
6203  {
6204    assumeStdFlag(u->next);
6205  }
6206  if ((!noK) && (k == 0))
6207  {
6208    WerrorS("Provided number of minors to be computed is zero.");
6209    return TRUE;
6210  }
6211  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6212      && (strcmp(algorithm, "Laplace") != 0)
6213      && (strcmp(algorithm, "Cache") != 0))
6214  {
6215    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6216    return TRUE;
6217  }
6218  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6219      && (!currRingIsOverIntegralDomain()))
6220  {
6221    Werror("Bareiss algorithm not defined over coefficient rings %s",
6222           "with zero divisors.");
6223    return TRUE;
6224  }
6225  res->rtyp=IDEAL_CMD;
6226  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6227  {
6228    ideal I=idInit(1,1);
6229    if (mk<1) I->m[0]=p_One(currRing);
6230    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6231    //       m->rows(), m->cols());
6232    res->data=(void*)I;
6233    return FALSE;
6234  }
6235  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6236      && (noCacheMinors || noCacheMonomials))
6237  {
6238    cacheMinors = 200;
6239    cacheMonomials = 100000;
6240  }
6241
6242  /* here come the actual procedure calls */
6243  if (noAlgorithm)
6244    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6245                                       (noIdeal ? 0 : IasSB), false);
6246  else if (strcmp(algorithm, "Cache") == 0)
6247    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6248                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6249                                   cacheMonomials, false);
6250  else
6251    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6252                              (noIdeal ? 0 : IasSB), false);
6253  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6254  return FALSE;
6255}
6256static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6257{
6258  // u: the name of the new type
6259  // v: the parent type
6260  // w: the elements
6261  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6262                                            (const char *)w->Data());
6263  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6264  return (d==NULL);
6265}
6266static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6267{
6268  // handles preimage(r,phi,i) and kernel(r,phi)
6269  idhdl h;
6270  ring rr;
6271  map mapping;
6272  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6273
6274  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6275  {
6276    WerrorS("2nd/3rd arguments must have names");
6277    return TRUE;
6278  }
6279  rr=(ring)u->Data();
6280  const char *ring_name=u->Name();
6281  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6282  {
6283    if (h->typ==MAP_CMD)
6284    {
6285      mapping=IDMAP(h);
6286      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6287      if ((preim_ring==NULL)
6288      || (IDRING(preim_ring)!=currRing))
6289      {
6290        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6291        return TRUE;
6292      }
6293    }
6294    else if (h->typ==IDEAL_CMD)
6295    {
6296      mapping=IDMAP(h);
6297    }
6298    else
6299    {
6300      Werror("`%s` is no map nor ideal",IDID(h));
6301      return TRUE;
6302    }
6303  }
6304  else
6305  {
6306    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6307    return TRUE;
6308  }
6309  ideal image;
6310  if (kernel_cmd) image=idInit(1,1);
6311  else
6312  {
6313    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6314    {
6315      if (h->typ==IDEAL_CMD)
6316      {
6317        image=IDIDEAL(h);
6318      }
6319      else
6320      {
6321        Werror("`%s` is no ideal",IDID(h));
6322        return TRUE;
6323      }
6324    }
6325    else
6326    {
6327      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6328      return TRUE;
6329    }
6330  }
6331  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6332  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6333  {
6334    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6335  }
6336  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6337  if (kernel_cmd) idDelete(&image);
6338  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6339}
6340static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6341{
6342  int di, k;
6343  int i=(int)(long)u->Data();
6344  int r=(int)(long)v->Data();
6345  int c=(int)(long)w->Data();
6346  if ((r<=0) || (c<=0)) return TRUE;
6347  intvec *iv = new intvec(r, c, 0);
6348  if (iv->rows()==0)
6349  {
6350    delete iv;
6351    return TRUE;
6352  }
6353  if (i!=0)
6354  {
6355    if (i<0) i = -i;
6356    di = 2 * i + 1;
6357    for (k=0; k<iv->length(); k++)
6358    {
6359      (*iv)[k] = ((siRand() % di) - i);
6360    }
6361  }
6362  res->data = (char *)iv;
6363  return FALSE;
6364}
6365#ifdef SINGULAR_4_1
6366static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6367// <coeff>, par1, par2 -> number2
6368{
6369  coeffs cf=(coeffs)w->Data();
6370  if ((cf==NULL) ||(cf->cfRandom==NULL))
6371  {
6372    Werror("no random function defined for coeff %d",cf->type);
6373    return TRUE;
6374  }
6375  else
6376  {
6377    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6378    number2 nn=(number2)omAlloc(sizeof(*nn));
6379    nn->cf=cf;
6380    nn->n=n;
6381    res->data=nn;
6382    return FALSE;
6383  }
6384  return TRUE;
6385}
6386#endif
6387static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6388  int &ringvar, poly &monomexpr)
6389{
6390  monomexpr=(poly)w->Data();
6391  poly p=(poly)v->Data();
6392#if 0
6393  if (pLength(monomexpr)>1)
6394  {
6395    Werror("`%s` substitutes a ringvar only by a term",
6396      Tok2Cmdname(SUBST_CMD));
6397    return TRUE;
6398  }
6399#endif
6400  if ((ringvar=pVar(p))==0)
6401  {
6402    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6403    {
6404      number n = pGetCoeff(p);
6405      ringvar= -n_IsParam(n, currRing);
6406    }
6407    if(ringvar==0)
6408    {
6409      WerrorS("ringvar/par expected");
6410      return TRUE;
6411    }
6412  }
6413  return FALSE;
6414}
6415static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6416{
6417  int ringvar;
6418  poly monomexpr;
6419  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6420  if (nok) return TRUE;
6421  poly p=(poly)u->Data();
6422  if (ringvar>0)
6423  {
6424    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6425    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p)/2)))
6426    {
6427      Warn("possible OVERFLOW in subst, max exponent is %ld, substituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), pTotaldegree(p));
6428      //return TRUE;
6429    }
6430    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6431      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6432    else
6433      res->data= pSubstPoly(p,ringvar,monomexpr);
6434  }
6435  else
6436  {
6437    res->data=pSubstPar(p,-ringvar,monomexpr);
6438  }
6439  return FALSE;
6440}
6441static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6442{
6443  int ringvar;
6444  poly monomexpr;
6445  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6446  if (nok) return TRUE;
6447  ideal id=(ideal)u->Data();
6448  if (ringvar>0)
6449  {
6450    BOOLEAN overflow=FALSE;
6451    if (monomexpr!=NULL)
6452    {
6453      long deg_monexp=pTotaldegree(monomexpr);
6454      for(int i=IDELEMS(id)-1;i>=0;i--)
6455      {
6456        poly p=id->m[i];
6457        if ((p!=NULL) && (pTotaldegree(p)!=0) &&
6458        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)pTotaldegree(p)/2)))
6459        {
6460          overflow=TRUE;
6461          break;
6462        }
6463      }
6464    }
6465    if (overflow)
6466      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6467    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6468    {
6469      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6470      else                       id=id_Copy(id,currRing);
6471      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6472    }
6473    else
6474      res->data = idSubstPoly(id,ringvar,monomexpr);
6475  }
6476  else
6477  {
6478    res->data = idSubstPar(id,-ringvar,monomexpr);
6479  }
6480  return FALSE;
6481}
6482// we do not want to have jjSUBST_Id_X inlined:
6483static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6484                            int input_type);
6485static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6486{
6487  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6488}
6489static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6490{
6491  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6492}
6493static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6494{
6495  sleftv tmp;
6496  memset(&tmp,0,sizeof(tmp));
6497  // do not check the result, conversion from int/number to poly works always
6498  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6499  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6500  tmp.CleanUp();
6501  return b;
6502}
6503static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6504{
6505  int mi=(int)(long)v->Data();
6506  int ni=(int)(long)w->Data();
6507  if ((mi<1)||(ni<1))
6508  {
6509    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6510    return TRUE;
6511  }
6512  matrix m=mpNew(mi,ni);
6513  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6514  int i=si_min(IDELEMS(I),mi*ni);
6515  //for(i=i-1;i>=0;i--)
6516  //{
6517  //  m->m[i]=I->m[i];
6518  //  I->m[i]=NULL;
6519  //}
6520  memcpy(m->m,I->m,i*sizeof(poly));
6521  memset(I->m,0,i*sizeof(poly));
6522  id_Delete(&I,currRing);
6523  res->data = (char *)m;
6524  return FALSE;
6525}
6526static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6527{
6528  int mi=(int)(long)v->Data();
6529  int ni=(int)(long)w->Data();
6530  if ((mi<1)||(ni<1))
6531  {
6532    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6533    return TRUE;
6534  }
6535  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6536           mi,ni,currRing);
6537  return FALSE;
6538}
6539static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6540{
6541  int mi=(int)(long)v->Data();
6542  int ni=(int)(long)w->Data();
6543  if ((mi<1)||(ni<1))
6544  {
6545     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6546    return TRUE;
6547  }
6548  matrix m=mpNew(mi,ni);
6549  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6550  int r=si_min(MATROWS(I),mi);
6551  int c=si_min(MATCOLS(I),ni);
6552  int i,j;
6553  for(i=r;i>0;i--)
6554  {
6555    for(j=c;j>0;j--)
6556    {
6557      MATELEM(m,i,j)=MATELEM(I,i,j);
6558      MATELEM(I,i,j)=NULL;
6559    }
6560  }
6561  id_Delete((ideal *)&I,currRing);
6562  res->data = (char *)m;
6563  return FALSE;
6564}
6565static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6566{
6567  if (w->rtyp!=IDHDL) return TRUE;
6568  int ul= IDELEMS((ideal)u->Data());
6569  int vl= IDELEMS((ideal)v->Data());
6570  ideal m
6571    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6572             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6573  if (m==NULL) return TRUE;
6574  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6575  return FALSE;
6576}
6577static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6578{
6579  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6580  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6581  idhdl hv=(idhdl)v->data;
6582  idhdl hw=(idhdl)w->data;
6583  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6584  res->data = (char *)idLiftStd((ideal)u->Data(),
6585                                &(hv->data.umatrix),testHomog,
6586                                &(hw->data.uideal));
6587  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6588  return FALSE;
6589}
6590static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6591{
6592  assumeStdFlag(v);
6593  if (!idIsZeroDim((ideal)v->Data()))
6594  {
6595    Werror("`%s` must be 0-dimensional",v->Name());
6596    return TRUE;
6597  }
6598  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6599    (poly)w->CopyD());
6600  return FALSE;
6601}
6602static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6603{
6604  assumeStdFlag(v);
6605  if (!idIsZeroDim((ideal)v->Data()))
6606  {
6607    Werror("`%s` must be 0-dimensional",v->Name());
6608    return TRUE;
6609  }
6610  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6611    (matrix)w->CopyD());
6612  return FALSE;
6613}
6614static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6615{
6616  assumeStdFlag(v);
6617  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6618    0,(int)(long)w->Data());
6619  return FALSE;
6620}
6621static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6622{
6623  assumeStdFlag(v);
6624  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6625    0,(int)(long)w->Data());
6626  return FALSE;
6627}
6628#ifdef OLD_RES
6629static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6630{
6631  int maxl=(int)v->Data();
6632  ideal u_id=(ideal)u->Data();
6633  int l=0;
6634  resolvente r;
6635  intvec **weights=NULL;
6636  int wmaxl=maxl;
6637  maxl--;
6638  if ((maxl==-1) && (iiOp!=MRES_CMD))
6639    maxl = currRing->N-1;
6640  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6641  {
6642    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6643    if (iv!=NULL)
6644    {
6645      l=1;
6646      if (!idTestHomModule(u_id,currRing->qideal,iv))
6647      {
6648        WarnS("wrong weights");
6649        iv=NULL;
6650      }
6651      else
6652      {
6653        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6654        weights[0] = ivCopy(iv);
6655      }
6656    }
6657    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6658  }
6659  else
6660    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6661  if (r==NULL) return TRUE;
6662  int t3=u->Typ();
6663  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6664  return FALSE;
6665}
6666#endif
6667static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6668{
6669  res->data=(void *)rInit(u,v,w);
6670  return (res->data==NULL);
6671}
6672static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6673{
6674  int yes;
6675  jjSTATUS2(res, u, v);
6676  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6677  omFree((ADDRESS) res->data);
6678  res->data = (void *)(long)yes;
6679  return FALSE;
6680}
6681static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6682{
6683  intvec *vw=(intvec *)w->Data(); // weights of vars
6684  if (vw->length()!=currRing->N)
6685  {
6686    Werror("%d weights for %d variables",vw->length(),currRing->N);
6687    return TRUE;
6688  }
6689  ideal result;
6690  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6691  tHomog hom=testHomog;
6692  ideal u_id=(ideal)(u->Data());
6693  if (ww!=NULL)
6694  {
6695    if (!idTestHomModule(u_id,currRing->qideal,ww))
6696    {
6697      WarnS("wrong weights");
6698      ww=NULL;
6699    }
6700    else
6701    {
6702      ww=ivCopy(ww);
6703      hom=isHomog;
6704    }
6705  }
6706  result=kStd(u_id,
6707              currRing->qideal,
6708              hom,
6709              &ww,                  // module weights
6710              (intvec *)v->Data(),  // hilbert series
6711              0,0,                  // syzComp, newIdeal
6712              vw);                  // weights of vars
6713  idSkipZeroes(result);
6714  res->data = (char *)result;
6715  setFlag(res,FLAG_STD);
6716  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6717  return FALSE;
6718}
6719
6720/*=================== operations with many arg.: static proc =================*/
6721/* must be ordered: first operations for chars (infix ops),
6722 * then alphabetically */
6723static BOOLEAN jjBREAK0(leftv, leftv)
6724{
6725#ifdef HAVE_SDB
6726  sdb_show_bp();
6727#endif
6728  return FALSE;
6729}
6730static BOOLEAN jjBREAK1(leftv, leftv v)
6731{
6732#ifdef HAVE_SDB
6733  if(v->Typ()==PROC_CMD)
6734  {
6735    int lineno=0;
6736    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6737    {
6738      lineno=(int)(long)v->next->Data();
6739    }
6740    return sdb_set_breakpoint(v->Name(),lineno);
6741  }
6742  return TRUE;
6743#else
6744 return FALSE;
6745#endif
6746}
6747static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6748{
6749  return iiExprArith1(res,v,iiOp);
6750}
6751static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6752{
6753  leftv v=u->next;
6754  u->next=NULL;
6755  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6756  u->next=v;
6757  return b;
6758}
6759static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6760{
6761  leftv v = u->next;
6762  leftv w = v->next;
6763  u->next = NULL;
6764  v->next = NULL;
6765  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6766  u->next = v;
6767  v->next = w;
6768  return b;
6769}
6770
6771static BOOLEAN jjCOEF_M(leftv, leftv v)
6772{
6773  short t[]={5,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD,IDHDL};
6774  if (iiCheckTypes(v,t))
6775     return TRUE;
6776  idhdl c=(idhdl)v->next->next->data;
6777  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6778  idhdl m=(idhdl)v->next->next->next->data;
6779  idDelete((ideal *)&(c->data.uideal));
6780  idDelete((ideal *)&(m->data.uideal));
6781  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6782    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6783  return FALSE;
6784}
6785
6786static BOOLEAN jjDIVISION4(leftv res, leftv v)
6787{ // may have 3 or 4 arguments
6788  leftv v1=v;
6789  leftv v2=v1->next;
6790  leftv v3=v2->next;
6791  leftv v4=v3->next;
6792  assumeStdFlag(v2);
6793
6794  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6795  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6796
6797  if((i1==0)||(i2==0)
6798  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6799  {
6800    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6801    return TRUE;
6802  }
6803
6804  sleftv w1,w2;
6805  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6806  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6807  ideal P=(ideal)w1.Data();
6808  ideal Q=(ideal)w2.Data();
6809
6810  int n=(int)(long)v3->Data();
6811  short *w=NULL;
6812  if(v4!=NULL)
6813  {
6814    w = iv2array((intvec *)v4->Data(),currRing);
6815    short * w0 = w + 1;
6816    int i = currRing->N;
6817    while( (i > 0) && ((*w0) > 0) )
6818    {
6819      w0++;
6820      i--;
6821    }
6822    if(i>0)
6823      WarnS("not all weights are positive!");
6824  }
6825
6826  matrix T;
6827  ideal R;
6828  idLiftW(P,Q,n,T,R,w);
6829
6830  w1.CleanUp();
6831  w2.CleanUp();
6832  if(w!=NULL)
6833    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
6834
6835  lists L=(lists) omAllocBin(slists_bin);
6836  L->Init(2);
6837  L->m[1].rtyp=v1->Typ();
6838  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6839  {
6840    if(v1->Typ()==POLY_CMD)
6841      p_Shift(&R->m[0],-1,currRing);
6842    L->m[1].data=(void *)R->m[0];
6843    R->m[0]=NULL;
6844    idDelete(&R);
6845  }
6846  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6847    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6848  else
6849  {
6850    L->m[1].rtyp=MODUL_CMD;
6851    L->m[1].data=(void *)R;
6852  }
6853  L->m[0].rtyp=MATRIX_CMD;
6854  L->m[0].data=(char *)T;
6855
6856  res->data=L;
6857  res->rtyp=LIST_CMD;
6858
6859  return FALSE;
6860}
6861
6862//BOOLEAN jjDISPATCH(leftv res, leftv v)
6863//{
6864//  WerrorS("`dispatch`: not implemented");
6865//  return TRUE;
6866//}
6867
6868//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6869//{
6870//  int l=u->listLength();
6871//  if (l<2) return TRUE;
6872//  BOOLEAN b;
6873//  leftv v=u->next;
6874//  leftv zz=v;
6875//  leftv z=zz;
6876//  u->next=NULL;
6877//  do
6878//  {
6879//    leftv z=z->next;
6880//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6881//    if (b) break;
6882//  } while (z!=NULL);
6883//  u->next=zz;
6884//  return b;
6885//}
6886static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6887{
6888  int s=1;
6889  leftv h=v;
6890  if (h!=NULL) s=exprlist_length(h);
6891  ideal id=idInit(s,1);
6892  int rank=1;
6893  int i=0;
6894  poly p;
6895  while (h!=NULL)
6896  {
6897    switch(h->Typ())
6898    {
6899      case POLY_CMD:
6900      {
6901        p=(poly)h->CopyD(POLY_CMD);
6902        break;
6903      }
6904      case INT_CMD:
6905      {
6906        number n=nInit((int)(long)h->Data());
6907        if (!nIsZero(n))
6908        {
6909          p=pNSet(n);
6910        }
6911        else
6912        {
6913          p=NULL;
6914          nDelete(&n);
6915        }
6916        break;
6917      }
6918      case BIGINT_CMD:
6919      {
6920        number b=(number)h->Data();
6921        nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
6922        if (nMap==NULL) return TRUE;
6923        number n=nMap(b,coeffs_BIGINT,currRing->cf);
6924        if (!nIsZero(n))
6925        {
6926          p=pNSet(n);
6927        }
6928        else
6929        {
6930          p=NULL;
6931          nDelete(&n);
6932        }
6933        break;
6934      }
6935      case NUMBER_CMD:
6936      {
6937        number n=(number)h->CopyD(NUMBER_CMD);
6938        if (!nIsZero(n))
6939        {
6940          p=pNSet(n);
6941        }
6942        else
6943        {
6944          p=NULL;
6945          nDelete(&n);
6946        }
6947        break;
6948      }
6949      case VECTOR_CMD:
6950      {
6951        p=(poly)h->CopyD(VECTOR_CMD);
6952        if (iiOp!=MODUL_CMD)
6953        {
6954          idDelete(&id);
6955          pDelete(&p);
6956          return TRUE;
6957        }
6958        rank=si_max(rank,(int)pMaxComp(p));
6959        break;
6960      }
6961      default:
6962      {
6963        idDelete(&id);
6964        return TRUE;
6965      }
6966    }
6967    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6968    {
6969      pSetCompP(p,1);
6970    }
6971    id->m[i]=p;
6972    i++;
6973    h=h->next;
6974  }
6975  id->rank=rank;
6976  res->data=(char *)id;
6977  return FALSE;
6978}
6979static BOOLEAN jjFETCH_M(leftv res, leftv u)
6980{
6981  ring r=(ring)u->Data();
6982  leftv v=u->next;
6983  leftv perm_var_l=v->next;
6984  leftv perm_par_l=v->next->next;
6985  if ((perm_var_l->Typ()!=INTVEC_CMD)
6986  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
6987  ||(u->Typ()!=RING_CMD))
6988  {
6989    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
6990    return TRUE;
6991  }
6992  intvec *perm_var_v=(intvec*)perm_var_l->Data();
6993  intvec *perm_par_v=NULL;
6994  if (perm_par_l!=NULL)
6995    perm_par_v=(intvec*)perm_par_l->Data();
6996  idhdl w;
6997  nMapFunc nMap;
6998
6999  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
7000  {
7001    int *perm=NULL;
7002    int *par_perm=NULL;
7003    int par_perm_size=0;
7004    BOOLEAN bo;
7005    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
7006    {
7007      // Allow imap/fetch to be make an exception only for:
7008      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
7009            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
7010             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
7011           ||
7012           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
7013            (rField_is_Zp(currRing, r->cf->ch) ||
7014             rField_is_Zp_a(currRing, r->cf->ch))) )
7015      {
7016        par_perm_size=rPar(r);
7017      }
7018      else
7019      {
7020        goto err_fetch;
7021      }
7022    }
7023    else
7024      par_perm_size=rPar(r);
7025    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
7026    if (par_perm_size!=0)
7027      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
7028    int i;
7029    if (perm_par_l==NULL)
7030    {
7031      if (par_perm_size!=0)
7032        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
7033    }
7034    else
7035    {
7036      if (par_perm_size==0) WarnS("source ring has no parameters");
7037      else
7038      {
7039        for(i=rPar(r)-1;i>=0;i--)
7040        {
7041          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
7042          if ((par_perm[i]<-rPar(currRing))
7043          || (par_perm[i]>rVar(currRing)))
7044          {
7045            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
7046            par_perm[i]=0;
7047          }
7048        }
7049      }
7050    }
7051    for(i=rVar(r)-1;i>=0;i--)
7052    {
7053      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
7054      if ((perm[i]<-rPar(currRing))
7055      || (perm[i]>rVar(currRing)))
7056      {
7057        Warn("invalid entry for var %d: %d\n",i,perm[i]);
7058        perm[i]=0;
7059      }
7060    }
7061    if (BVERBOSE(V_IMAP))
7062    {
7063      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
7064      {
7065        if (perm[i]>0)
7066          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
7067        else if (perm[i]<0)
7068          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
7069      }
7070      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
7071      {
7072        if (par_perm[i-1]<0)
7073          Print("// par nr %d: %s -> par %s\n",
7074              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
7075        else if (par_perm[i-1]>0)
7076          Print("// par nr %d: %s -> var %s\n",
7077              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7078      }
7079    }
7080    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7081    sleftv tmpW;
7082    memset(&tmpW,0,sizeof(sleftv));
7083    tmpW.rtyp=IDTYP(w);
7084    tmpW.data=IDDATA(w);
7085    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7086                         perm,par_perm,par_perm_size,nMap)))
7087    {
7088      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7089    }
7090    if (perm!=NULL)
7091      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7092    if (par_perm!=NULL)
7093      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7094    return bo;
7095  }
7096  else
7097  {
7098    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7099  }
7100  return TRUE;
7101err_fetch:
7102  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
7103         nCoeffString(r->cf),
7104         nCoeffString(currRing->cf));
7105  return TRUE;
7106}
7107static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7108{
7109  leftv h=v;
7110  int l=v->listLength();
7111  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7112  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7113  int t=0;
7114  // try to convert to IDEAL_CMD
7115  while (h!=NULL)
7116  {
7117    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7118    {
7119      t=IDEAL_CMD;
7120    }
7121    else break;
7122    h=h->next;
7123  }
7124  // if failure, try MODUL_CMD
7125  if (t==0)
7126  {
7127    h=v;
7128    while (h!=NULL)
7129    {
7130      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7131      {
7132        t=MODUL_CMD;
7133      }
7134      else break;
7135      h=h->next;
7136    }
7137  }
7138  // check for success  in converting
7139  if (t==0)
7140  {
7141    WerrorS("cannot convert to ideal or module");
7142    return TRUE;
7143  }
7144  // call idMultSect
7145  h=v;
7146  int i=0;
7147  sleftv tmp;
7148  while (h!=NULL)
7149  {
7150    if (h->Typ()==t)
7151    {
7152      r[i]=(ideal)h->Data(); /*no copy*/
7153      h=h->next;
7154    }
7155    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7156    {
7157      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7158      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7159      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7160      return TRUE;
7161    }
7162    else
7163    {
7164      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7165      copied[i]=TRUE;
7166      h=tmp.next;
7167    }
7168    i++;
7169  }
7170  res->rtyp=t;
7171  res->data=(char *)idMultSect(r,i);
7172  while(i>0)
7173  {
7174    i--;
7175    if (copied[i]) idDelete(&(r[i]));
7176  }
7177  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7178  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7179  return FALSE;
7180}
7181static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7182{
7183  /* computation of the inverse of a quadratic matrix A
7184     using the L-U-decomposition of A;
7185     There are two valid parametrisations:
7186     1) exactly one argument which is just the matrix A,
7187     2) exactly three arguments P, L, U which already
7188        realise the L-U-decomposition of A, that is,
7189        P * A = L * U, and P, L, and U satisfy the
7190        properties decribed in method 'jjLU_DECOMP';
7191        see there;
7192     If A is invertible, the list [1, A^(-1)] is returned,
7193     otherwise the list [0] is returned. Thus, the user may
7194     inspect the first entry of the returned list to see
7195     whether A is invertible. */
7196  matrix iMat; int invertible;
7197  short t1[]={1,MATRIX_CMD};
7198  short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7199  if (iiCheckTypes(v,t1))
7200  {
7201    matrix aMat = (matrix)v->Data();
7202    int rr = aMat->rows();
7203    int cc = aMat->cols();
7204    if (rr != cc)
7205    {
7206      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7207      return TRUE;
7208    }
7209    if (!idIsConstant((ideal)aMat))
7210    {
7211      WerrorS("matrix must be constant");
7212      return TRUE;
7213    }
7214    invertible = luInverse(aMat, iMat);
7215  }
7216  else if (iiCheckTypes(v,t2))
7217  {
7218     matrix pMat = (matrix)v->Data();
7219     matrix lMat = (matrix)v->next->Data();
7220     matrix uMat = (matrix)v->next->next->Data();
7221     int rr = uMat->rows();
7222     int cc = uMat->cols();
7223     if (rr != cc)
7224     {
7225       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7226              rr, cc);
7227       return TRUE;
7228     }
7229      if (!idIsConstant((ideal)pMat)
7230      || (!idIsConstant((ideal)lMat))
7231      || (!idIsConstant((ideal)uMat))
7232      )
7233      {
7234        WerrorS("matricesx must be constant");
7235        return TRUE;
7236      }
7237     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7238  }
7239  else
7240  {
7241    Werror("expected either one or three matrices");
7242    return TRUE;
7243  }
7244
7245  /* build the return structure; a list with either one or two entries */
7246  lists ll = (lists)omAllocBin(slists_bin);
7247  if (invertible)
7248  {
7249    ll->Init(2);
7250    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7251    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7252  }
7253  else
7254  {
7255    ll->Init(1);
7256    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7257  }
7258
7259  res->data=(char*)ll;
7260  return FALSE;
7261}
7262static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7263{
7264  /* for solving a linear equation system A * x = b, via the
7265     given LU-decomposition of the matrix A;
7266     There is one valid parametrisation:
7267     1) exactly four arguments P, L, U, b;
7268        P, L, and U realise the L-U-decomposition of A, that is,
7269        P * A = L * U, and P, L, and U satisfy the
7270        properties decribed in method 'jjLU_DECOMP';
7271        see there;
7272        b is the right-hand side vector of the equation system;
7273     The method will return a list of either 1 entry or three entries:
7274     1) [0] if there is no solution to the system;
7275     2) [1, x, H] if there is at least one solution;
7276        x is any solution of the given linear system,
7277        H is the matrix with column vectors spanning the homogeneous
7278        solution space.
7279     The method produces an error if matrix and vector sizes do not fit. */
7280  short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7281  if (!iiCheckTypes(v,t))
7282  {
7283    WerrorS("expected exactly three matrices and one vector as input");
7284    return TRUE;
7285  }
7286  matrix pMat = (matrix)v->Data();
7287  matrix lMat = (matrix)v->next->Data();
7288  matrix uMat = (matrix)v->next->next->Data();
7289  matrix bVec = (matrix)v->next->next->next->Data();
7290  matrix xVec; int solvable; matrix homogSolSpace;
7291  if (pMat->rows() != pMat->cols())
7292  {
7293    Werror("first matrix (%d x %d) is not quadratic",
7294           pMat->rows(), pMat->cols());
7295    return TRUE;
7296  }
7297  if (lMat->rows() != lMat->cols())
7298  {
7299    Werror("second matrix (%d x %d) is not quadratic",
7300           lMat->rows(), lMat->cols());
7301    return TRUE;
7302  }
7303  if (lMat->rows() != uMat->rows())
7304  {
7305    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7306           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7307    return TRUE;
7308  }
7309  if (uMat->rows() != bVec->rows())
7310  {
7311    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7312           uMat->rows(), uMat->cols(), bVec->rows());
7313    return TRUE;
7314  }
7315  if (!idIsConstant((ideal)pMat)
7316  ||(!idIsConstant((ideal)lMat))
7317  ||(!idIsConstant((ideal)uMat))
7318  )
7319  {
7320    WerrorS("matrices must be constant");
7321    return TRUE;
7322  }
7323  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7324
7325  /* build the return structure; a list with either one or three entries */
7326  lists ll = (lists)omAllocBin(slists_bin);
7327  if (solvable)
7328  {
7329    ll->Init(3);
7330    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7331    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7332    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7333  }
7334  else
7335  {
7336    ll->Init(1);
7337    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7338  }
7339
7340  res->data=(char*)ll;
7341  return FALSE;
7342}
7343static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7344{
7345  int i=0;
7346  leftv h=v;
7347  if (h!=NULL) i=exprlist_length(h);
7348  intvec *iv=new intvec(i);
7349  i=0;
7350  while (h!=NULL)
7351  {
7352    if(h->Typ()==INT_CMD)
7353    {
7354      (*iv)[i]=(int)(long)h->Data();
7355    }
7356    else if (h->Typ()==INTVEC_CMD)
7357    {
7358      intvec *ivv=(intvec*)h->Data();
7359      for(int j=0;j<ivv->length();j++,i++)
7360      {
7361        (*iv)[i]=(*ivv)[j];
7362      }
7363      i--;
7364    }
7365    else
7366    {
7367      delete iv;
7368      return TRUE;
7369    }
7370    i++;
7371    h=h->next;
7372  }
7373  res->data=(char *)iv;
7374  return FALSE;
7375}
7376static BOOLEAN jjJET4(leftv res, leftv u)
7377{
7378  short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7379  short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7380  short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7381  short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7382  leftv u1=u;
7383  leftv u2=u1->next;
7384  leftv u3=u2->next;
7385  leftv u4=u3->next;
7386  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7387  {
7388    if(!pIsUnit((poly)u2->Data()))
7389    {
7390      WerrorS("2nd argument must be a unit");
7391      return TRUE;
7392    }
7393    res->rtyp=u1->Typ();
7394    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7395                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7396    return FALSE;
7397  }
7398  else
7399  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7400  {
7401    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7402    {
7403      WerrorS("2nd argument must be a diagonal matrix of units");
7404      return TRUE;
7405    }
7406    res->rtyp=u1->Typ();
7407    res->data=(char*)idSeries(
7408                              (int)(long)u3->Data(),
7409                              idCopy((ideal)u1->Data()),
7410                              mp_Copy((matrix)u2->Data(), currRing),
7411                              (intvec*)u4->Data()
7412                             );
7413    return FALSE;
7414  }
7415  else
7416  {
7417    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7418           Tok2Cmdname(iiOp));
7419    return TRUE;
7420  }
7421}
7422#if 0
7423static BOOLEAN jjBRACKET_PL(leftv res, leftv u)
7424{
7425  int ut=u->Typ();
7426  leftv v=u->next; u->next=NULL;
7427  leftv w=v->next; v->next=NULL;
7428  if ((ut!=CRING_CMD)&&(ut!=RING_CMD))
7429  {
7430    BOOLEAN bo=TRUE;
7431    if (w==NULL)
7432    {
7433      bo=iiExprArith2(res,u,'[',v);
7434    }
7435    else if (w->next==NULL)
7436    {
7437      bo=iiExprArith3(res,'[',u,v,w);
7438    }
7439    v->next=w;
7440    u->next=v;
7441    return bo;
7442  }
7443  v->next=w;
7444  u->next=v;
7445  #ifdef SINGULAR_4_1
7446  // construct new rings:
7447  while (u!=NULL)
7448  {
7449    Print("name: %s,\n",u->Name());
7450    u=u->next;
7451  }
7452  #else
7453  memset(res,0,sizeof(sleftv));
7454  res->rtyp=NONE;
7455  return TRUE;
7456  #endif
7457}
7458#endif
7459static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7460{
7461  if ((yyInRingConstruction)
7462  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7463  {
7464    memcpy(res,u,sizeof(sleftv));
7465    memset(u,0,sizeof(sleftv));
7466    return FALSE;
7467  }
7468  leftv v=u->next;
7469  BOOLEAN b;
7470  if(v==NULL)
7471    b=iiExprArith1(res,u,iiOp);
7472  else
7473  {
7474    u->next=NULL;
7475    b=iiExprArith2(res,u,iiOp,v);
7476    u->next=v;
7477  }
7478  return b;
7479}
7480BOOLEAN jjLIST_PL(leftv res, leftv v)
7481{
7482  int sl=0;
7483  if (v!=NULL) sl = v->listLength();
7484  lists L;
7485  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7486  {
7487    int add_row_shift = 0;
7488    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7489    if (weights!=NULL)  add_row_shift=weights->min_in();
7490    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7491  }
7492  else
7493  {
7494    L=(lists)omAllocBin(slists_bin);
7495    leftv h=NULL;
7496    int i;
7497    int rt;
7498
7499    L->Init(sl);
7500    for (i=0;i<sl;i++)
7501    {
7502      if (h!=NULL)
7503      { /* e.g. not in the first step:
7504         * h is the pointer to the old sleftv,
7505         * v is the pointer to the next sleftv
7506         * (in this moment) */
7507         h->next=v;
7508      }
7509      h=v;
7510      v=v->next;
7511      h->next=NULL;
7512      rt=h->Typ();
7513      if (rt==0)
7514      {
7515        L->Clean();
7516        Werror("`%s` is undefined",h->Fullname());
7517        return TRUE;
7518      }
7519      if (rt==RING_CMD)
7520      {
7521        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7522        ((ring)L->m[i].data)->ref++;
7523      }
7524      else
7525        L->m[i].Copy(h);
7526    }
7527  }
7528  res->data=(char *)L;
7529  return FALSE;
7530}
7531static BOOLEAN jjNAMES0(leftv res, leftv)
7532{
7533  res->data=(void *)ipNameList(IDROOT);
7534  return FALSE;
7535}
7536static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7537{
7538  if(v==NULL)
7539  {
7540    res->data=(char *)showOption();
7541    return FALSE;
7542  }
7543  res->rtyp=NONE;
7544  return setOption(res,v);
7545}
7546static BOOLEAN jjREDUCE4(leftv res, leftv u)
7547{
7548  leftv u1=u;
7549  leftv u2=u1->next;
7550  leftv u3=u2->next;
7551  leftv u4=u3->next;
7552  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7553  {
7554    int save_d=Kstd1_deg;
7555    Kstd1_deg=(int)(long)u3->Data();
7556    kModW=(intvec *)u4->Data();
7557    BITSET save2;
7558    SI_SAVE_OPT2(save2);
7559    si_opt_2|=Sy_bit(V_DEG_STOP);
7560    u2->next=NULL;
7561    BOOLEAN r=jjCALL2ARG(res,u);
7562    kModW=NULL;
7563    Kstd1_deg=save_d;
7564    SI_RESTORE_OPT2(save2);
7565    u->next->next=u3;
7566    return r;
7567  }
7568  else
7569  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7570     (u4->Typ()==INT_CMD))
7571  {
7572    assumeStdFlag(u3);
7573    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7574    {
7575      WerrorS("2nd argument must be a diagonal matrix of units");
7576      return TRUE;
7577    }
7578    res->rtyp=IDEAL_CMD;
7579    res->data=(char*)redNF(
7580                           idCopy((ideal)u3->Data()),
7581                           idCopy((ideal)u1->Data()),
7582                           mp_Copy((matrix)u2->Data(), currRing),
7583                           (int)(long)u4->Data()
7584                          );
7585    return FALSE;
7586  }
7587  else
7588  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7589     (u4->Typ()==INT_CMD))
7590  {
7591    assumeStdFlag(u3);
7592    if(!pIsUnit((poly)u2->Data()))
7593    {
7594      WerrorS("2nd argument must be a unit");
7595      return TRUE;
7596    }
7597    res->rtyp=POLY_CMD;
7598    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7599                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7600    return FALSE;
7601  }
7602  else
7603  {
7604    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7605    return TRUE;
7606  }
7607}
7608static BOOLEAN jjREDUCE5(leftv res, leftv u)
7609{
7610  leftv u1=u;
7611  leftv u2=u1->next;
7612  leftv u3=u2->next;
7613  leftv u4=u3->next;
7614  leftv u5=u4->next;
7615  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7616     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7617  {
7618    assumeStdFlag(u3);
7619    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7620    {
7621      WerrorS("2nd argument must be a diagonal matrix of units");
7622      return TRUE;
7623    }
7624    res->rtyp=IDEAL_CMD;
7625    res->data=(char*)redNF(
7626                           idCopy((ideal)u3->Data()),
7627                           idCopy((ideal)u1->Data()),
7628                           mp_Copy((matrix)u2->Data(),currRing),
7629                           (int)(long)u4->Data(),
7630                           (intvec*)u5->Data()
7631                          );
7632    return FALSE;
7633  }
7634  else
7635  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7636     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7637  {
7638    assumeStdFlag(u3);
7639    if(!pIsUnit((poly)u2->Data()))
7640    {
7641      WerrorS("2nd argument must be a unit");
7642      return TRUE;
7643    }
7644    res->rtyp=POLY_CMD;
7645    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7646                           pCopy((poly)u2->Data()),
7647                           (int)(long)u4->Data(),(intvec*)u5->Data());
7648    return FALSE;
7649  }
7650  else
7651  {
7652    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7653           Tok2Cmdname(iiOp));
7654    return TRUE;
7655  }
7656}
7657static BOOLEAN jjRESERVED0(leftv, leftv)
7658{
7659  int i=1;
7660  int nCount = (sArithBase.nCmdUsed-1)/3;
7661  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7662  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7663  //      sArithBase.nCmdAllocated);
7664  for(i=0; i<nCount; i++)
7665  {
7666    Print("%-20s",sArithBase.sCmds[i+1].name);
7667    if(i+1+nCount<sArithBase.nCmdUsed)
7668      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7669    if(i+1+2*nCount<sArithBase.nCmdUsed)
7670      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7671    //if ((i%3)==1) PrintLn();
7672    PrintLn();
7673  }
7674  PrintLn();
7675  printBlackboxTypes();
7676  return FALSE;
7677}
7678static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7679{
7680  if (v == NULL)
7681  {
7682    res->data = omStrDup("");
7683    return FALSE;
7684  }
7685  int n = v->listLength();
7686  if (n == 1)
7687  {
7688    res->data = v->String();
7689    return FALSE;
7690  }
7691
7692  char** slist = (char**) omAlloc(n*sizeof(char*));
7693  int i, j;
7694
7695  for (i=0, j=0; i<n; i++, v = v ->next)
7696  {
7697    slist[i] = v->String();
7698    assume(slist[i] != NULL);
7699    j+=strlen(slist[i]);
7700  }
7701  char* s = (char*) omAlloc((j+1)*sizeof(char));
7702  *s='\0';
7703  for (i=0;i<n;i++)
7704  {
7705    strcat(s, slist[i]);
7706    omFree(slist[i]);
7707  }
7708  omFreeSize(slist, n*sizeof(char*));
7709  res->data = s;
7710  return FALSE;
7711}
7712static BOOLEAN jjTEST(leftv, leftv v)
7713{
7714  do
7715  {
7716    if (v->Typ()!=INT_CMD)
7717      return TRUE;
7718    test_cmd((int)(long)v->Data());
7719    v=v->next;
7720  }
7721  while (v!=NULL);
7722  return FALSE;
7723}
7724
7725#if defined(__alpha) && !defined(linux)
7726extern "C"
7727{
7728  void usleep(unsigned long usec);
7729};
7730#endif
7731static BOOLEAN jjFactModD_M(leftv res, leftv v)
7732{
7733  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7734     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
7735
7736     valid argument lists:
7737     - (poly h, int d),
7738     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7739     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7740                                                          in list of ring vars,
7741     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7742                                                optional: all 4 optional args
7743     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7744      by singclap_factorize and h(0, y)
7745      has exactly two distinct monic factors [possibly with exponent > 1].)
7746     result:
7747     - list with the two factors f and g such that
7748       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7749
7750  poly h      = NULL;
7751  int  d      =    1;
7752  poly f0     = NULL;
7753  poly g0     = NULL;
7754  int  xIndex =    1;   /* default index if none provided */
7755  int  yIndex =    2;   /* default index if none provided */
7756
7757  leftv u = v; int factorsGiven = 0;
7758  if ((u == NULL) || (u->Typ() != POLY_CMD))
7759  {
7760    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7761    return TRUE;
7762  }
7763  else h = (poly)u->Data();
7764  u = u->next;
7765  if ((u == NULL) || (u->Typ() != INT_CMD))
7766  {
7767    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7768    return TRUE;
7769  }
7770  else d = (int)(long)u->Data();
7771  u = u->next;
7772  if ((u != NULL) && (u->Typ() == POLY_CMD))
7773  {
7774    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7775    {
7776      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7777      return TRUE;
7778    }
7779    else
7780    {
7781      f0 = (poly)u->Data();
7782      g0 = (poly)u->next->Data();
7783      factorsGiven = 1;
7784      u = u->next->next;
7785    }
7786  }
7787  if ((u != NULL) && (u->Typ() == INT_CMD))
7788  {
7789    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7790    {
7791      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7792      return TRUE;
7793    }
7794    else
7795    {
7796      xIndex = (int)(long)u->Data();
7797      yIndex = (int)(long)u->next->Data();
7798      u = u->next->next;
7799    }
7800  }
7801  if (u != NULL)
7802  {
7803    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7804    return TRUE;
7805  }
7806
7807  /* checks for provided arguments */
7808  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7809  {
7810    WerrorS("expected non-constant polynomial argument(s)");
7811    return TRUE;
7812  }
7813  int n = rVar(currRing);
7814  if ((xIndex < 1) || (n < xIndex))
7815  {
7816    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7817    return TRUE;
7818  }
7819  if ((yIndex < 1) || (n < yIndex))
7820  {
7821    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7822    return TRUE;
7823  }
7824  if (xIndex == yIndex)
7825  {
7826    WerrorS("expected distinct indices for variables x and y");
7827    return TRUE;
7828  }
7829
7830  /* computation of f0 and g0 if missing */
7831  if (factorsGiven == 0)
7832  {
7833    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7834    intvec* v = NULL;
7835    ideal i = singclap_factorize(h0, &v, 0,currRing);
7836
7837    ivTest(v);
7838
7839    if (i == NULL) return TRUE;
7840
7841    idTest(i);
7842
7843    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7844    {
7845      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7846      return TRUE;
7847    }
7848    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7849    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7850    idDelete(&i);
7851  }
7852
7853  poly f; poly g;
7854  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7855  lists L = (lists)omAllocBin(slists_bin);
7856  L->Init(2);
7857  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7858  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7859  res->rtyp = LIST_CMD;
7860  res->data = (char*)L;
7861  return FALSE;
7862}
7863static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7864{
7865  if ((v->Typ() != LINK_CMD) ||
7866      (v->next->Typ() != STRING_CMD) ||
7867      (v->next->next->Typ() != STRING_CMD) ||
7868      (v->next->next->next->Typ() != INT_CMD))
7869    return TRUE;
7870  jjSTATUS3(res, v, v->next, v->next->next);
7871#if defined(HAVE_USLEEP)
7872  if (((long) res->data) == 0L)
7873  {
7874    int i_s = (int)(long) v->next->next->next->Data();
7875    if (i_s > 0)
7876    {
7877      usleep((int)(long) v->next->next->next->Data());
7878      jjSTATUS3(res, v, v->next, v->next->next);
7879    }
7880  }
7881#elif defined(HAVE_SLEEP)
7882  if (((int) res->data) == 0)
7883  {
7884    int i_s = (int) v->next->next->next->Data();
7885    if (i_s > 0)
7886    {
7887      si_sleep((is - 1)/1000000 + 1);
7888      jjSTATUS3(res, v, v->next, v->next->next);
7889    }
7890  }
7891#endif
7892  return FALSE;
7893}
7894static BOOLEAN jjSUBST_M(leftv res, leftv u)
7895{
7896  leftv v = u->next; // number of args > 0
7897  if (v==NULL) return TRUE;
7898  leftv w = v->next;
7899  if (w==NULL) return TRUE;
7900  leftv rest = w->next;;
7901
7902  u->next = NULL;
7903  v->next = NULL;
7904  w->next = NULL;
7905  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7906  if ((rest!=NULL) && (!b))
7907  {
7908    sleftv tmp_res;
7909    leftv tmp_next=res->next;
7910    res->next=rest;
7911    memset(&tmp_res,0,sizeof(tmp_res));
7912    b = iiExprArithM(&tmp_res,res,iiOp);
7913    memcpy(res,&tmp_res,sizeof(tmp_res));
7914    res->next=tmp_next;
7915  }
7916  u->next = v;
7917  v->next = w;
7918  // rest was w->next, but is already cleaned
7919  return b;
7920}
7921static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7922{
7923  if ((INPUT->Typ() != MATRIX_CMD) ||
7924      (INPUT->next->Typ() != NUMBER_CMD) ||
7925      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7926      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7927  {
7928    WerrorS("expected (matrix, number, number, number) as arguments");
7929    return TRUE;
7930  }
7931  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7932  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7933                                    (number)(v->Data()),
7934                                    (number)(w->Data()),
7935                                    (number)(x->Data()));
7936  return FALSE;
7937}
7938static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7939{ ideal result;
7940  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7941  leftv v = u->next;  /* one additional polynomial or ideal */
7942  leftv h = v->next;  /* Hilbert vector */
7943  leftv w = h->next;  /* weight vector */
7944  assumeStdFlag(u);
7945  ideal i1=(ideal)(u->Data());
7946  ideal i0;
7947  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7948  || (h->Typ()!=INTVEC_CMD)
7949  || (w->Typ()!=INTVEC_CMD))
7950  {
7951    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7952    return TRUE;
7953  }
7954  intvec *vw=(intvec *)w->Data(); // weights of vars
7955  /* merging std_hilb_w and std_1 */
7956  if (vw->length()!=currRing->N)
7957  {
7958    Werror("%d weights for %d variables",vw->length(),currRing->N);
7959    return TRUE;
7960  }
7961  int r=v->Typ();
7962  BOOLEAN cleanup_i0=FALSE;
7963  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7964  {
7965    i0=idInit(1,i1->rank);
7966    i0->m[0]=(poly)v->Data();
7967    cleanup_i0=TRUE;
7968  }
7969  else if (r==IDEAL_CMD)/* IDEAL */
7970  {
7971    i0=(ideal)v->Data();
7972  }
7973  else
7974  {
7975    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7976    return TRUE;
7977  }
7978  int ii0=idElem(i0);
7979  i1 = idSimpleAdd(i1,i0);
7980  if (cleanup_i0)
7981  {
7982    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7983    idDelete(&i0);
7984  }
7985  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7986  tHomog hom=testHomog;
7987  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7988  if (ww!=NULL)
7989  {
7990    if (!idTestHomModule(i1,currRing->qideal,ww))
7991    {
7992      WarnS("wrong weights");
7993      ww=NULL;
7994    }
7995    else
7996    {
7997      ww=ivCopy(ww);
7998      hom=isHomog;
7999    }
8000  }
8001  BITSET save1;
8002  SI_SAVE_OPT1(save1);
8003  si_opt_1|=Sy_bit(OPT_SB_1);
8004  result=kStd(i1,
8005              currRing->qideal,
8006              hom,
8007              &ww,                  // module weights
8008              (intvec *)h->Data(),  // hilbert series
8009              0,                    // syzComp, whatever it is...
8010              IDELEMS(i1)-ii0,      // new ideal
8011              vw);                  // weights of vars
8012  SI_RESTORE_OPT1(save1);
8013  idDelete(&i1);
8014  idSkipZeroes(result);
8015  res->data = (char *)result;
8016  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
8017  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
8018  return FALSE;
8019}
8020
8021#ifdef SINGULAR_4_1
8022static BOOLEAN jjRING_PL(leftv res, leftv a)
8023{
8024  Print("construct ring\n");
8025  if (a->Typ()!=CRING_CMD)
8026  {
8027    WerrorS("expected `Ring` [ `id` ... ]");
8028    return TRUE;
8029  }
8030  assume(a->next!=NULL);
8031  leftv names=a->next;
8032  int N=names->listLength();
8033  char **n=(char**)omAlloc0(N*sizeof(char*));
8034  for(int i=0; i<N;i++,names=names->next)
8035  {
8036    n[i]=(char *)names->Name();
8037  }
8038  coeffs cf=(coeffs)a->CopyD();
8039  res->data=rDefault(cf,N,n, ringorder_dp);
8040  omFreeSize(n,N*sizeof(char*));
8041  return FALSE;
8042}
8043#endif
8044
8045static Subexpr jjMakeSub(leftv e)
8046{
8047  assume( e->Typ()==INT_CMD );
8048  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
8049  r->start =(int)(long)e->Data();
8050  return r;
8051}
8052#define D(A)    (A)
8053#define NULL_VAL NULL
8054#define IPARITH
8055#include "table.h"
8056
8057#include "iparith.inc"
8058
8059/*=================== operations with 2 args. ============================*/
8060/* must be ordered: first operations for chars (infix ops),
8061 * then alphabetically */
8062
8063static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
8064                                    BOOLEAN proccall,
8065                                    const struct sValCmd2* dA2,
8066                                    int at, int bt,
8067                                    const struct sConvertTypes *dConvertTypes)
8068{
8069  memset(res,0,sizeof(sleftv));
8070  BOOLEAN call_failed=FALSE;
8071
8072  if (!errorreported)
8073  {
8074    int i=0;
8075    iiOp=op;
8076    while (dA2[i].cmd==op)
8077    {
8078      if ((at==dA2[i].arg1)
8079      && (bt==dA2[i].arg2))
8080      {
8081        res->rtyp=dA2[i].res;
8082        if (currRing!=NULL)
8083        {
8084          if (check_valid(dA2[i].valid_for,op)) break;
8085        }
8086        else
8087        {
8088          if (RingDependend(dA2[i].res))
8089          {
8090            WerrorS("no ring active");
8091            break;
8092          }
8093        }
8094        if (traceit&TRACE_CALL)
8095          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
8096        if ((call_failed=dA2[i].p(res,a,b)))
8097        {
8098          break;// leave loop, goto error handling
8099        }
8100        a->CleanUp();
8101        b->CleanUp();
8102        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8103        return FALSE;
8104      }
8105      i++;
8106    }
8107    // implicite type conversion ----------------------------------------------
8108    if (dA2[i].cmd!=op)
8109    {
8110      int ai,bi;
8111      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8112      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8113      BOOLEAN failed=FALSE;
8114      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8115      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8116      while (dA2[i].cmd==op)
8117      {
8118        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8119        if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8120        {
8121          if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8122          {
8123            res->rtyp=dA2[i].res;
8124            if (currRing!=NULL)
8125            {
8126              if (check_valid(dA2[i].valid_for,op)) break;
8127            }
8128            else
8129            {
8130              if (RingDependend(dA2[i].res))
8131              {
8132                WerrorS("no ring active");
8133                break;
8134              }
8135            }
8136            if (traceit&TRACE_CALL)
8137              Print("call %s(%s,%s)\n",iiTwoOps(op),
8138              Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8139            failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8140            || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8141            || (call_failed=dA2[i].p(res,an,bn)));
8142            // everything done, clean up temp. variables
8143            if (failed)
8144            {
8145              // leave loop, goto error handling
8146              break;
8147            }
8148            else
8149            {
8150              // everything ok, clean up and return
8151              an->CleanUp();
8152              bn->CleanUp();
8153              omFreeBin((ADDRESS)an, sleftv_bin);
8154              omFreeBin((ADDRESS)bn, sleftv_bin);
8155              a->CleanUp();
8156              b->CleanUp();
8157              return FALSE;
8158            }
8159          }
8160        }
8161        i++;
8162      }
8163      an->CleanUp();
8164      bn->CleanUp();
8165      omFreeBin((ADDRESS)an, sleftv_bin);
8166      omFreeBin((ADDRESS)bn, sleftv_bin);
8167    }
8168    // error handling ---------------------------------------------------
8169    const char *s=NULL;
8170    if (!errorreported)
8171    {
8172      if ((at==0) && (a->Fullname()!=sNoName))
8173      {
8174        s=a->Fullname();
8175      }
8176      else if ((bt==0) && (b->Fullname()!=sNoName))
8177      {
8178        s=b->Fullname();
8179      }
8180      if (s!=NULL)
8181        Werror("`%s` is not defined",s);
8182      else
8183      {
8184        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8185        s = iiTwoOps(op);
8186        if (proccall)
8187        {
8188          Werror("%s(`%s`,`%s`) failed"
8189                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8190        }
8191        else
8192        {
8193          Werror("`%s` %s `%s` failed"
8194                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8195        }
8196        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8197        {
8198          while (dA2[i].cmd==op)
8199          {
8200            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8201            && (dA2[i].res!=0)
8202            && (dA2[i].p!=jjWRONG2))
8203            {
8204              if (proccall)
8205                Werror("expected %s(`%s`,`%s`)"
8206                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8207              else
8208                Werror("expected `%s` %s `%s`"
8209                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8210            }
8211            i++;
8212          }
8213        }
8214      }
8215    }
8216    res->rtyp = UNKNOWN;
8217  }
8218  a->CleanUp();
8219  b->CleanUp();
8220  return TRUE;
8221}
8222BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8223                                    const struct sValCmd2* dA2,
8224                                    int at,
8225                                    const struct sConvertTypes *dConvertTypes)
8226{
8227  leftv b=a->next;
8228  a->next=NULL;
8229  int bt=b->Typ();
8230  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8231  a->next=b;
8232  a->CleanUp();
8233  return bo;
8234}
8235BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8236{
8237  memset(res,0,sizeof(sleftv));
8238
8239  if (!errorreported)
8240  {
8241#ifdef SIQ
8242    if (siq>0)
8243    {
8244      //Print("siq:%d\n",siq);
8245      command d=(command)omAlloc0Bin(sip_command_bin);
8246      memcpy(&d->arg1,a,sizeof(sleftv));
8247      //a->Init();
8248      memcpy(&d->arg2,b,sizeof(sleftv));
8249      //b->Init();
8250      d->argc=2;
8251      d->op=op;
8252      res->data=(char *)d;
8253      res->rtyp=COMMAND;
8254      return FALSE;
8255    }
8256#endif
8257    int at=a->Typ();
8258    int bt=b->Typ();
8259    // handling bb-objects ----------------------------------------------------
8260    if (at>MAX_TOK)
8261    {
8262      blackbox *bb=getBlackboxStuff(at);
8263      if (bb!=NULL)
8264      {
8265        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8266        if (errorreported) return TRUE;
8267        // else: no op defined
8268      }
8269      else          return TRUE;
8270    }
8271    else if ((bt>MAX_TOK)&&(op!='('))
8272    {
8273      blackbox *bb=getBlackboxStuff(bt);
8274      if (bb!=NULL)
8275      {
8276        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8277        if (errorreported) return TRUE;
8278        // else: no op defined
8279      }
8280      else          return TRUE;
8281    }
8282    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8283    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8284  }
8285  a->CleanUp();
8286  b->CleanUp();
8287  return TRUE;
8288}
8289
8290/*==================== operations with 1 arg. ===============================*/
8291/* must be ordered: first operations for chars (infix ops),
8292 * then alphabetically */
8293
8294BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, const struct sValCmd1* dA1, int at, const struct sConvertTypes *dConvertTypes)
8295{
8296  memset(res,0,sizeof(sleftv));
8297  BOOLEAN call_failed=FALSE;
8298
8299  if (!errorreported)
8300  {
8301    BOOLEAN failed=FALSE;
8302    iiOp=op;
8303    int i = 0;
8304    while (dA1[i].cmd==op)
8305    {
8306      if (at==dA1[i].arg)
8307      {
8308        if (currRing!=NULL)
8309        {
8310          if (check_valid(dA1[i].valid_for,op)) break;
8311        }
8312        else
8313        {
8314          if (RingDependend(dA1[i].res))
8315          {
8316            WerrorS("no ring active");
8317            break;
8318          }
8319        }
8320        if (traceit&TRACE_CALL)
8321          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8322        res->rtyp=dA1[i].res;
8323        if ((call_failed=dA1[i].p(res,a)))
8324        {
8325          break;// leave loop, goto error handling
8326        }
8327        if (a->Next()!=NULL)
8328        {
8329          res->next=(leftv)omAllocBin(sleftv_bin);
8330          failed=iiExprArith1(res->next,a->next,op);
8331        }
8332        a->CleanUp();
8333        return failed;
8334      }
8335      i++;
8336    }
8337    // implicite type conversion --------------------------------------------
8338    if (dA1[i].cmd!=op)
8339    {
8340      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8341      i=0;
8342      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8343      while (dA1[i].cmd==op)
8344      {
8345        int ai;
8346        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8347        if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8348        {
8349          if (currRing!=NULL)
8350          {
8351            if (check_valid(dA1[i].valid_for,op)) break;
8352          }
8353          else
8354          {
8355            if (RingDependend(dA1[i].res))
8356            {
8357              WerrorS("no ring active");
8358              break;
8359            }
8360          }
8361          if (traceit&TRACE_CALL)
8362            Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8363          res->rtyp=dA1[i].res;
8364          failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8365          || (call_failed=dA1[i].p(res,an)));
8366          // everything done, clean up temp. variables
8367          if (failed)
8368          {
8369            // leave loop, goto error handling
8370            break;
8371          }
8372          else
8373          {
8374            if (an->Next() != NULL)
8375            {
8376              res->next = (leftv)omAllocBin(sleftv_bin);
8377              failed=iiExprArith1(res->next,an->next,op);
8378            }
8379            // everything ok, clean up and return
8380            an->CleanUp();
8381            omFreeBin((ADDRESS)an, sleftv_bin);
8382            a->CleanUp();
8383            return failed;
8384          }
8385        }
8386        i++;
8387      }
8388      an->CleanUp();
8389      omFreeBin((ADDRESS)an, sleftv_bin);
8390    }
8391    // error handling
8392    if (!errorreported)
8393    {
8394      if ((at==0) && (a->Fullname()!=sNoName))
8395      {
8396        Werror("`%s` is not defined",a->Fullname());
8397      }
8398      else
8399      {
8400        i=0;
8401        const char *s = iiTwoOps(op);
8402        Werror("%s(`%s`) failed"
8403                ,s,Tok2Cmdname(at));
8404        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8405        {
8406          while (dA1[i].cmd==op)
8407          {
8408            if ((dA1[i].res!=0)
8409            && (dA1[i].p!=jjWRONG))
8410              Werror("expected %s(`%s`)"
8411                ,s,Tok2Cmdname(dA1[i].arg));
8412            i++;
8413          }
8414        }
8415      }
8416    }
8417    res->rtyp = UNKNOWN;
8418  }
8419  a->CleanUp();
8420  return TRUE;
8421}
8422BOOLEAN iiExprArith1(leftv res, leftv a, int op)
8423{
8424  memset(res,0,sizeof(sleftv));
8425
8426  if (!errorreported)
8427  {
8428#ifdef SIQ
8429    if (siq>0)
8430    {
8431      //Print("siq:%d\n",siq);
8432      command d=(command)omAlloc0Bin(sip_command_bin);
8433      memcpy(&d->arg1,a,sizeof(sleftv));
8434      //a->Init();
8435      d->op=op;
8436      d->argc=1;
8437      res->data=(char *)d;
8438      res->rtyp=COMMAND;
8439      return FALSE;
8440    }
8441#endif
8442    int at=a->Typ();
8443    // handling bb-objects ----------------------------------------------------
8444    if(op>MAX_TOK) // explicit type conversion to bb
8445    {
8446      blackbox *bb=getBlackboxStuff(op);
8447      if (bb!=NULL)
8448      {
8449        res->rtyp=op;
8450        res->data=bb->blackbox_Init(bb);
8451        if(!bb->blackbox_Assign(res,a)) return FALSE;
8452        if (errorreported) return TRUE;
8453      }
8454      else          return TRUE;
8455    }
8456    else if (at>MAX_TOK) // argument is of bb-type
8457    {
8458      blackbox *bb=getBlackboxStuff(at);
8459      if (bb!=NULL)
8460      {
8461        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
8462        if (errorreported) return TRUE;
8463        // else: no op defined
8464      }
8465      else          return TRUE;
8466    }
8467
8468    iiOp=op;
8469    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8470    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
8471  }
8472  a->CleanUp();
8473  return TRUE;
8474}
8475
8476/*=================== operations with 3 args. ============================*/
8477/* must be ordered: first operations for chars (infix ops),
8478 * then alphabetically */
8479
8480static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
8481  const struct sValCmd3* dA3, int at, int bt, int ct,
8482  const struct sConvertTypes *dConvertTypes)
8483{
8484  memset(res,0,sizeof(sleftv));
8485  BOOLEAN call_failed=FALSE;
8486
8487  assume(dA3[0].cmd==op);
8488
8489  if (!errorreported)
8490  {
8491    int i=0;
8492    iiOp=op;
8493    while (dA3[i].cmd==op)
8494    {
8495      if ((at==dA3[i].arg1)
8496      && (bt==dA3[i].arg2)
8497      && (ct==dA3[i].arg3))
8498      {
8499        res->rtyp=dA3[i].res;
8500        if (currRing!=NULL)
8501        {
8502          if (check_valid(dA3[i].valid_for,op)) break;
8503        }
8504        if (traceit&TRACE_CALL)
8505          Print("call %s(%s,%s,%s)\n",
8506            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8507        if ((call_failed=dA3[i].p(res,a,b,c)))
8508        {
8509          break;// leave loop, goto error handling
8510        }
8511        a->CleanUp();
8512        b->CleanUp();
8513        c->CleanUp();
8514        return FALSE;
8515      }
8516      i++;
8517    }
8518    // implicite type conversion ----------------------------------------------
8519    if (dA3[i].cmd!=op)
8520    {
8521      int ai,bi,ci;
8522      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8523      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8524      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8525      BOOLEAN failed=FALSE;
8526      i=0;
8527      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8528      while (dA3[i].cmd==op)
8529      {
8530        if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
8531        {
8532          if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
8533          {
8534            if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
8535            {
8536              res->rtyp=dA3[i].res;
8537              if (currRing!=NULL)
8538              {
8539                if (check_valid(dA3[i].valid_for,op)) break;
8540              }
8541              if (traceit&TRACE_CALL)
8542                Print("call %s(%s,%s,%s)\n",
8543                  iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
8544                  Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
8545              failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
8546                || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
8547                || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
8548                || (call_failed=dA3[i].p(res,an,bn,cn)));
8549              // everything done, clean up temp. variables
8550              if (failed)
8551              {
8552                // leave loop, goto error handling
8553                break;
8554              }
8555              else
8556              {
8557                // everything ok, clean up and return
8558                an->CleanUp();
8559                bn->CleanUp();
8560                cn->CleanUp();
8561                omFreeBin((ADDRESS)an, sleftv_bin);
8562                omFreeBin((ADDRESS)bn, sleftv_bin);
8563                omFreeBin((ADDRESS)cn, sleftv_bin);
8564                a->CleanUp();
8565                b->CleanUp();
8566                c->CleanUp();
8567        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8568                return FALSE;
8569              }
8570            }
8571          }
8572        }
8573        i++;
8574      }
8575      an->CleanUp();
8576      bn->CleanUp();
8577      cn->CleanUp();
8578      omFreeBin((ADDRESS)an, sleftv_bin);
8579      omFreeBin((ADDRESS)bn, sleftv_bin);
8580      omFreeBin((ADDRESS)cn, sleftv_bin);
8581    }
8582    // error handling ---------------------------------------------------
8583    if (!errorreported)
8584    {
8585      const char *s=NULL;
8586      if ((at==0) && (a->Fullname()!=sNoName))
8587      {
8588        s=a->Fullname();
8589      }
8590      else if ((bt==0) && (b->Fullname()!=sNoName))
8591      {
8592        s=b->Fullname();
8593      }
8594      else if ((ct==0) && (c->Fullname()!=sNoName))
8595      {
8596        s=c->Fullname();
8597      }
8598      if (s!=NULL)
8599        Werror("`%s` is not defined",s);
8600      else
8601      {
8602        i=0;
8603        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8604        const char *s = iiTwoOps(op);
8605        Werror("%s(`%s`,`%s`,`%s`) failed"
8606                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8607        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8608        {
8609          while (dA3[i].cmd==op)
8610          {
8611            if(((at==dA3[i].arg1)
8612            ||(bt==dA3[i].arg2)
8613            ||(ct==dA3[i].arg3))
8614            && (dA3[i].res!=0))
8615            {
8616              Werror("expected %s(`%s`,`%s`,`%s`)"
8617                  ,s,Tok2Cmdname(dA3[i].arg1)
8618                  ,Tok2Cmdname(dA3[i].arg2)
8619                  ,Tok2Cmdname(dA3[i].arg3));
8620            }
8621            i++;
8622          }
8623        }
8624      }
8625    }
8626    res->rtyp = UNKNOWN;
8627  }
8628  a->CleanUp();
8629  b->CleanUp();
8630  c->CleanUp();
8631        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8632  return TRUE;
8633}
8634BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8635{
8636  memset(res,0,sizeof(sleftv));
8637
8638  if (!errorreported)
8639  {
8640#ifdef SIQ
8641    if (siq>0)
8642    {
8643      //Print("siq:%d\n",siq);
8644      command d=(command)omAlloc0Bin(sip_command_bin);
8645      memcpy(&d->arg1,a,sizeof(sleftv));
8646      //a->Init();
8647      memcpy(&d->arg2,b,sizeof(sleftv));
8648      //b->Init();
8649      memcpy(&d->arg3,c,sizeof(sleftv));
8650      //c->Init();
8651      d->op=op;
8652      d->argc=3;
8653      res->data=(char *)d;
8654      res->rtyp=COMMAND;
8655      return FALSE;
8656    }
8657#endif
8658    int at=a->Typ();
8659    // handling bb-objects ----------------------------------------------
8660    if (at>MAX_TOK)
8661    {
8662      blackbox *bb=getBlackboxStuff(at);
8663      if (bb!=NULL)
8664      {
8665        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8666        if (errorreported) return TRUE;
8667        // else: no op defined
8668      }
8669      else          return TRUE;
8670      if (errorreported) return TRUE;
8671    }
8672    int bt=b->Typ();
8673    int ct=c->Typ();
8674
8675    iiOp=op;
8676    int i=0;
8677    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8678    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8679  }
8680  a->CleanUp();
8681  b->CleanUp();
8682  c->CleanUp();
8683        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8684  return TRUE;
8685}
8686BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
8687                                    const struct sValCmd3* dA3,
8688                                    int at,
8689                                    const struct sConvertTypes *dConvertTypes)
8690{
8691  leftv b=a->next;
8692  a->next=NULL;
8693  int bt=b->Typ();
8694  leftv c=b->next;
8695  b->next=NULL;
8696  int ct=c->Typ();
8697  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8698  b->next=c;
8699  a->next=b;
8700  a->CleanUp();
8701  return bo;
8702}
8703/*==================== operations with many arg. ===============================*/
8704/* must be ordered: first operations for chars (infix ops),
8705 * then alphabetically */
8706
8707static BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8708{
8709  // cnt = 0: all
8710  // cnt = 1: only first one
8711  leftv next;
8712  BOOLEAN failed = TRUE;
8713  if(v==NULL) return failed;
8714  res->rtyp = LIST_CMD;
8715  if(cnt) v->next = NULL;
8716  next = v->next;             // saving next-pointer
8717  failed = jjLIST_PL(res, v);
8718  v->next = next;             // writeback next-pointer
8719  return failed;
8720}
8721
8722BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8723{
8724  memset(res,0,sizeof(sleftv));
8725
8726  if (!errorreported)
8727  {
8728#ifdef SIQ
8729    if (siq>0)
8730    {
8731      //Print("siq:%d\n",siq);
8732      command d=(command)omAlloc0Bin(sip_command_bin);
8733      d->op=op;
8734      res->data=(char *)d;
8735      if (a!=NULL)
8736      {
8737        d->argc=a->listLength();
8738        // else : d->argc=0;
8739        memcpy(&d->arg1,a,sizeof(sleftv));
8740        switch(d->argc)
8741        {
8742          case 3:
8743            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8744            a->next->next->Init();
8745            /* no break */
8746          case 2:
8747            memcpy(&d->arg2,a->next,sizeof(sleftv));
8748            a->next->Init();
8749            a->next->next=d->arg2.next;
8750            d->arg2.next=NULL;
8751            /* no break */
8752          case 1:
8753            a->Init();
8754            a->next=d->arg1.next;
8755            d->arg1.next=NULL;
8756        }
8757        if (d->argc>3) a->next=NULL;
8758        a->name=NULL;
8759        a->rtyp=0;
8760        a->data=NULL;
8761        a->e=NULL;
8762        a->attribute=NULL;
8763        a->CleanUp();
8764      }
8765      res->rtyp=COMMAND;
8766      return FALSE;
8767    }
8768#endif
8769    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8770    {
8771      blackbox *bb=getBlackboxStuff(a->Typ());
8772      if (bb!=NULL)
8773      {
8774        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
8775        if (errorreported) return TRUE;
8776        // else: no op defined
8777      }
8778      else          return TRUE;
8779    }
8780    int args=0;
8781    if (a!=NULL) args=a->listLength();
8782
8783    iiOp=op;
8784    int i=0;
8785    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8786    while (dArithM[i].cmd==op)
8787    {
8788      if ((args==dArithM[i].number_of_args)
8789      || (dArithM[i].number_of_args==-1)
8790      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8791      {
8792        res->rtyp=dArithM[i].res;
8793        if (currRing!=NULL)
8794        {
8795          if (check_valid(dArithM[i].valid_for,op)) break;
8796        }
8797        if (traceit&TRACE_CALL)
8798          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8799        if (dArithM[i].p(res,a))
8800        {
8801          break;// leave loop, goto error handling
8802        }
8803        if (a!=NULL) a->CleanUp();
8804        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8805        return FALSE;
8806      }
8807      i++;
8808    }
8809    // error handling
8810    if (!errorreported)
8811    {
8812      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8813      {
8814        Werror("`%s` is not defined",a->Fullname());
8815      }
8816      else
8817      {
8818        const char *s = iiTwoOps(op);
8819        Werror("%s(...) failed",s);
8820      }
8821    }
8822    res->rtyp = UNKNOWN;
8823  }
8824  if (a!=NULL) a->CleanUp();
8825        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8826  return TRUE;
8827}
8828
8829/*=================== general utilities ============================*/
8830int IsCmd(const char *n, int & tok)
8831{
8832  int i;
8833  int an=1;
8834  int en=sArithBase.nLastIdentifier;
8835
8836  loop
8837  //for(an=0; an<sArithBase.nCmdUsed; )
8838  {
8839    if(an>=en-1)
8840    {
8841      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8842      {
8843        i=an;
8844        break;
8845      }
8846      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8847      {
8848        i=en;
8849        break;
8850      }
8851      else
8852      {
8853        // -- blackbox extensions:
8854        // return 0;
8855        return blackboxIsCmd(n,tok);
8856      }
8857    }
8858    i=(an+en)/2;
8859    if (*n < *(sArithBase.sCmds[i].name))
8860    {
8861      en=i-1;
8862    }
8863    else if (*n > *(sArithBase.sCmds[i].name))
8864    {
8865      an=i+1;
8866    }
8867    else
8868    {
8869      int v=strcmp(n,sArithBase.sCmds[i].name);
8870      if(v<0)
8871      {
8872        en=i-1;
8873      }
8874      else if(v>0)
8875      {
8876        an=i+1;
8877      }
8878      else /*v==0*/
8879      {
8880        break;
8881      }
8882    }
8883  }
8884  lastreserved=sArithBase.sCmds[i].name;
8885  tok=sArithBase.sCmds[i].tokval;
8886  if(sArithBase.sCmds[i].alias==2)
8887  {
8888    Warn("outdated identifier `%s` used - please change your code",
8889    sArithBase.sCmds[i].name);
8890    sArithBase.sCmds[i].alias=1;
8891  }
8892  #if 0
8893  if (currRingHdl==NULL)
8894  {
8895    #ifdef SIQ
8896    if (siq<=0)
8897    {
8898    #endif
8899      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8900      {
8901        WerrorS("no ring active");
8902        return 0;
8903      }
8904    #ifdef SIQ
8905    }
8906    #endif
8907  }
8908  #endif
8909  if (!expected_parms)
8910  {
8911    switch (tok)
8912    {
8913      case IDEAL_CMD:
8914      case INT_CMD:
8915      case INTVEC_CMD:
8916      case MAP_CMD:
8917      case MATRIX_CMD:
8918      case MODUL_CMD:
8919      case POLY_CMD:
8920      case PROC_CMD:
8921      case RING_CMD:
8922      case STRING_CMD:
8923        cmdtok = tok;
8924        break;
8925    }
8926  }
8927  return sArithBase.sCmds[i].toktype;
8928}
8929static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8930{
8931  // user defined types are not in the pre-computed table:
8932  if (op>MAX_TOK) return 0;
8933
8934  int a=0;
8935  int e=len;
8936  int p=len/2;
8937  do
8938  {
8939     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8940     if (op<dArithTab[p].cmd) e=p-1;
8941     else   a = p+1;
8942     p=a+(e-a)/2;
8943  }
8944  while ( a <= e);
8945
8946  // catch missing a cmd:
8947  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
8948  // Print("op %d (%c) unknown",op,op);
8949  return 0;
8950}
8951
8952const char * Tok2Cmdname(int tok)
8953{
8954  if (tok <= 0)
8955  {
8956    return sArithBase.sCmds[0].name;
8957  }
8958  if (tok==ANY_TYPE) return "any_type";
8959  if (tok==COMMAND) return "command";
8960  if (tok==NONE) return "nothing";
8961  //if (tok==IFBREAK) return "if_break";
8962  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8963  //if (tok==ORDER_VECTOR) return "ordering";
8964  //if (tok==REF_VAR) return "ref";
8965  //if (tok==OBJECT) return "object";
8966  //if (tok==PRINT_EXPR) return "print_expr";
8967  if (tok==IDHDL) return "identifier";
8968  #ifdef SINGULAR_4_1
8969  //if (tok==CRING_CMD) return "Ring";
8970  #endif
8971  if (tok>MAX_TOK) return getBlackboxName(tok);
8972  int i;
8973  for(i=0; i<sArithBase.nCmdUsed; i++)
8974    //while (sArithBase.sCmds[i].tokval!=0)
8975  {
8976    if ((sArithBase.sCmds[i].tokval == tok)&&
8977        (sArithBase.sCmds[i].alias==0))
8978    {
8979      return sArithBase.sCmds[i].name;
8980    }
8981  }
8982  // try gain for alias/old names:
8983  for(i=0; i<sArithBase.nCmdUsed; i++)
8984  {
8985    if (sArithBase.sCmds[i].tokval == tok)
8986    {
8987      return sArithBase.sCmds[i].name;
8988    }
8989  }
8990  return sArithBase.sCmds[0].name;
8991}
8992
8993
8994/*---------------------------------------------------------------------*/
8995/**
8996 * @brief compares to entry of cmdsname-list
8997
8998 @param[in] a
8999 @param[in] b
9000
9001 @return <ReturnValue>
9002**/
9003/*---------------------------------------------------------------------*/
9004static int _gentable_sort_cmds( const void *a, const void *b )
9005{
9006  cmdnames *pCmdL = (cmdnames*)a;
9007  cmdnames *pCmdR = (cmdnames*)b;
9008
9009  if(a==NULL || b==NULL)             return 0;
9010
9011  /* empty entries goes to the end of the list for later reuse */
9012  if(pCmdL->name==NULL) return 1;
9013  if(pCmdR->name==NULL) return -1;
9014
9015  /* $INVALID$ must come first */
9016  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
9017  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
9018
9019  /* tokval=-1 are reserved names at the end */
9020  if (pCmdL->tokval==-1)
9021  {
9022    if (pCmdR->tokval==-1)
9023       return strcmp(pCmdL->name, pCmdR->name);
9024    /* pCmdL->tokval==-1, pCmdL goes at the end */
9025    return 1;
9026  }
9027  /* pCmdR->tokval==-1, pCmdR goes at the end */
9028  if(pCmdR->tokval==-1) return -1;
9029
9030  return strcmp(pCmdL->name, pCmdR->name);
9031}
9032
9033/*---------------------------------------------------------------------*/
9034/**
9035 * @brief initialisation of arithmetic structured data
9036
9037 @retval 0 on success
9038
9039**/
9040/*---------------------------------------------------------------------*/
9041int iiInitArithmetic()
9042{
9043  //printf("iiInitArithmetic()\n");
9044  memset(&sArithBase, 0, sizeof(sArithBase));
9045  iiInitCmdName();
9046  /* fix last-identifier */
9047#if 0
9048  /* we expect that gentable allready did every thing */
9049  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9050      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
9051    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9052  }
9053#endif
9054  //Print("L=%d\n", sArithBase.nLastIdentifier);
9055
9056  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
9057  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
9058
9059  //iiArithAddCmd("Top", 0,-1,0);
9060
9061
9062  //for(i=0; i<sArithBase.nCmdUsed; i++) {
9063  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
9064  //         sArithBase.sCmds[i].name,
9065  //         sArithBase.sCmds[i].alias,
9066  //         sArithBase.sCmds[i].tokval,
9067  //         sArithBase.sCmds[i].toktype);
9068  //}
9069  //iiArithRemoveCmd("Top");
9070  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
9071  //iiArithRemoveCmd("mygcd");
9072  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
9073  return 0;
9074}
9075
9076int iiArithFindCmd(const char *szName)
9077{
9078  int an=0;
9079  int i = 0,v = 0;
9080  int en=sArithBase.nLastIdentifier;
9081
9082  loop
9083  //for(an=0; an<sArithBase.nCmdUsed; )
9084  {
9085    if(an>=en-1)
9086    {
9087      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
9088      {
9089        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
9090        return an;
9091      }
9092      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
9093      {
9094        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
9095        return en;
9096      }
9097      else
9098      {
9099        //Print("RET- 1\n");
9100        return -1;
9101      }
9102    }
9103    i=(an+en)/2;
9104    if (*szName < *(sArithBase.sCmds[i].name))
9105    {
9106      en=i-1;
9107    }
9108    else if (*szName > *(sArithBase.sCmds[i].name))
9109    {
9110      an=i+1;
9111    }
9112    else
9113    {
9114      v=strcmp(szName,sArithBase.sCmds[i].name);
9115      if(v<0)
9116      {
9117        en=i-1;
9118      }
9119      else if(v>0)
9120      {
9121        an=i+1;
9122      }
9123      else /*v==0*/
9124      {
9125        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9126        return i;
9127      }
9128    }
9129  }
9130  //if(i>=0 && i<sArithBase.nCmdUsed)
9131  //  return i;
9132  //PrintS("RET-2\n");
9133  return -2;
9134}
9135
9136char *iiArithGetCmd( int nPos )
9137{
9138  if(nPos<0) return NULL;
9139  if(nPos<sArithBase.nCmdUsed)
9140    return sArithBase.sCmds[nPos].name;
9141  return NULL;
9142}
9143
9144int iiArithRemoveCmd(const char *szName)
9145{
9146  int nIndex;
9147  if(szName==NULL) return -1;
9148
9149  nIndex = iiArithFindCmd(szName);
9150  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
9151  {
9152    Print("'%s' not found (%d)\n", szName, nIndex);
9153    return -1;
9154  }
9155  omFree(sArithBase.sCmds[nIndex].name);
9156  sArithBase.sCmds[nIndex].name=NULL;
9157  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9158        (&_gentable_sort_cmds));
9159  sArithBase.nCmdUsed--;
9160
9161  /* fix last-identifier */
9162  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9163      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9164  {
9165    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9166  }
9167  //Print("L=%d\n", sArithBase.nLastIdentifier);
9168  return 0;
9169}
9170
9171int iiArithAddCmd(
9172  const char *szName,
9173  short nAlias,
9174  short nTokval,
9175  short nToktype,
9176  short nPos
9177  )
9178{
9179  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9180  //       nTokval, nToktype, nPos);
9181  if(nPos>=0)
9182  {
9183    // no checks: we rely on a correct generated code in iparith.inc
9184    assume(nPos < sArithBase.nCmdAllocated);
9185    assume(szName!=NULL);
9186    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9187    sArithBase.sCmds[nPos].alias   = nAlias;
9188    sArithBase.sCmds[nPos].tokval  = nTokval;
9189    sArithBase.sCmds[nPos].toktype = nToktype;
9190    sArithBase.nCmdUsed++;
9191    //if(nTokval>0) sArithBase.nLastIdentifier++;
9192  }
9193  else
9194  {
9195    if(szName==NULL) return -1;
9196    int nIndex = iiArithFindCmd(szName);
9197    if(nIndex>=0)
9198    {
9199      Print("'%s' already exists at %d\n", szName, nIndex);
9200      return -1;
9201    }
9202
9203    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9204    {
9205      /* needs to create new slots */
9206      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9207      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9208      if(sArithBase.sCmds==NULL) return -1;
9209      sArithBase.nCmdAllocated++;
9210    }
9211    /* still free slots available */
9212    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9213    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9214    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9215    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9216    sArithBase.nCmdUsed++;
9217
9218    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9219          (&_gentable_sort_cmds));
9220    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9221        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9222    {
9223      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9224    }
9225    //Print("L=%d\n", sArithBase.nLastIdentifier);
9226  }
9227  return 0;
9228}
9229
9230static BOOLEAN check_valid(const int p, const int op)
9231{
9232  #ifdef HAVE_PLURAL
9233  if (rIsPluralRing(currRing))
9234  {
9235    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
9236    {
9237      WerrorS("not implemented for non-commutative rings");
9238      return TRUE;
9239    }
9240    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
9241    {
9242      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
9243      return FALSE;
9244    }
9245    /* else, ALLOW_PLURAL */
9246  }
9247  #endif
9248  if (rField_is_Ring(currRing))
9249  {
9250    if ((p & RING_MASK)==0 /*NO_RING*/)
9251    {
9252      WerrorS("not implemented for rings with rings as coeffients");
9253      return TRUE;
9254    }
9255    /* else ALLOW_RING */
9256    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9257    &&(!rField_is_Domain(currRing)))
9258    {
9259      WerrorS("domain required as coeffients");
9260      return TRUE;
9261    }
9262    /* else ALLOW_ZERODIVISOR */
9263    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9264    {
9265      WarnS("considering the image in Q[...]");
9266    }
9267  }
9268  return FALSE;
9269}
Note: See TracBrowser for help on using the repository browser.