source: git/Singular/iparith.cc @ 426ee8

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