source: git/Singular/iparith.cc @ e09ceb

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