source: git/Singular/iparith.cc @ 7febab

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