source: git/Singular/iparith.cc @ 91f9f2

fieker-DuValspielwiese
Last change on this file since 91f9f2 was 98fe4c, checked in by Hans Schoenemann <hannes@…>, 3 years ago
move error test to jjDIV_P
  • Property mode set to 100644
File size: 252.0 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  res->data = (char *)0;
4610  return FALSE;
4611}
4612//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4613//{
4614//  return jjMONITOR2(res,v,NULL);
4615//}
4616static BOOLEAN jjMSTD(leftv res, leftv v)
4617{
4618  int t=v->Typ();
4619  ideal r,m;
4620  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4621  lists l=(lists)omAllocBin(slists_bin);
4622  l->Init(2);
4623  l->m[0].rtyp=t;
4624  l->m[0].data=(char *)r;
4625  setFlag(&(l->m[0]),FLAG_STD);
4626  l->m[1].rtyp=t;
4627  l->m[1].data=(char *)m;
4628  res->data=(char *)l;
4629  return FALSE;
4630}
4631static BOOLEAN jjMULT(leftv res, leftv v)
4632{
4633  assumeStdFlag(v);
4634  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4635  return FALSE;
4636}
4637static BOOLEAN jjMINRES_R(leftv res, leftv v)
4638{
4639  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4640
4641  syStrategy tmp=(syStrategy)v->Data();
4642  tmp = syMinimize(tmp); // enrich itself!
4643
4644  res->data=(char *)tmp;
4645
4646  if (weights!=NULL)
4647    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4648
4649  return FALSE;
4650}
4651static BOOLEAN jjN2BI(leftv res, leftv v)
4652{
4653  number n,i; i=(number)v->Data();
4654  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4655  if (nMap!=NULL)
4656    n=nMap(i,currRing->cf,coeffs_BIGINT);
4657  else goto err;
4658  res->data=(void *)n;
4659  return FALSE;
4660err:
4661  WerrorS("cannot convert to bigint"); return TRUE;
4662}
4663static BOOLEAN jjNAMEOF(leftv res, leftv v)
4664{
4665  if ((v->rtyp==IDHDL)||(v->rtyp==ALIAS_CMD))
4666    res->data=omStrDup(v->name);
4667  else if (v->name==NULL)
4668    res->data=omStrDup("");
4669  else
4670  {
4671    res->data = (char *)v->name;
4672    v->name=NULL;
4673  }
4674  return FALSE;
4675}
4676static BOOLEAN jjNAMES(leftv res, leftv v)
4677{
4678  res->data=ipNameList(((ring)v->Data())->idroot);
4679  return FALSE;
4680}
4681static BOOLEAN jjNAMES_I(leftv res, leftv v)
4682{
4683  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4684  return FALSE;
4685}
4686static BOOLEAN jjNOT(leftv res, leftv v)
4687{
4688  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4689  return FALSE;
4690}
4691static BOOLEAN jjNVARS(leftv res, leftv v)
4692{
4693  res->data = (char *)(long)(((ring)(v->Data()))->N);
4694  return FALSE;
4695}
4696static BOOLEAN jjOpenClose(leftv, leftv v)
4697{
4698  si_link l=(si_link)v->Data();
4699  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4700  else { slPrepClose(l); return slClose(l);}
4701}
4702static BOOLEAN jjORD(leftv res, leftv v)
4703{
4704  poly p=(poly)v->Data();
4705  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4706  return FALSE;
4707}
4708static BOOLEAN jjPAR1(leftv res, leftv v)
4709{
4710  int i=(int)(long)v->Data();
4711  int p=0;
4712  p=rPar(currRing);
4713  if ((0<i) && (i<=p))
4714  {
4715    res->data=(char *)n_Param(i,currRing);
4716  }
4717  else
4718  {
4719    Werror("par number %d out of range 1..%d",i,p);
4720    return TRUE;
4721  }
4722  return FALSE;
4723}
4724static BOOLEAN jjPARDEG(leftv res, leftv v)
4725{
4726  number nn=(number)v->Data();
4727  res->data = (char *)(long)n_ParDeg(nn, currRing->cf);
4728  return FALSE;
4729}
4730static BOOLEAN jjPARSTR1(leftv res, leftv v)
4731{
4732  if (currRing==NULL)
4733  {
4734    WerrorS("no ring active (1)");
4735    return TRUE;
4736  }
4737  int i=(int)(long)v->Data();
4738  int p=0;
4739  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4740    res->data=omStrDup(rParameter(currRing)[i-1]);
4741  else
4742  {
4743    Werror("par number %d out of range 1..%d",i,p);
4744    return TRUE;
4745  }
4746  return FALSE;
4747}
4748static BOOLEAN jjP2BI(leftv res, leftv v)
4749{
4750  poly p=(poly)v->Data();
4751  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4752  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4753  {
4754    WerrorS("poly must be constant");
4755    return TRUE;
4756  }
4757  number i=pGetCoeff(p);
4758  number n;
4759  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4760  if (nMap!=NULL)
4761    n=nMap(i,currRing->cf,coeffs_BIGINT);
4762  else goto err;
4763  res->data=(void *)n;
4764  return FALSE;
4765err:
4766  WerrorS("cannot convert to bigint"); return TRUE;
4767}
4768static BOOLEAN jjP2I(leftv res, leftv v)
4769{
4770  poly p=(poly)v->Data();
4771  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4772  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4773  {
4774    WerrorS("poly must be constant");
4775    return TRUE;
4776  }
4777  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4778  return FALSE;
4779}
4780static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4781{
4782  map mapping=(map)v->Data();
4783  syMake(res,omStrDup(mapping->preimage));
4784  return FALSE;
4785}
4786static BOOLEAN jjPRIME(leftv res, leftv v)
4787{
4788  int i = IsPrime((int)(long)(v->Data()));
4789  res->data = (char *)(long)(i > 1 ? i : 2);
4790  return FALSE;
4791}
4792static BOOLEAN jjPRUNE(leftv res, leftv v)
4793{
4794  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4795  ideal v_id=(ideal)v->Data();
4796  if (w!=NULL)
4797  {
4798    if (!idTestHomModule(v_id,currRing->qideal,w))
4799    {
4800      WarnS("wrong weights");
4801      w=NULL;
4802      // and continue at the non-homog case below
4803    }
4804    else
4805    {
4806      w=ivCopy(w);
4807      intvec **ww=&w;
4808      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4809      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4810      return FALSE;
4811    }
4812  }
4813  res->data = (char *)idMinEmbedding(v_id);
4814  return FALSE;
4815}
4816static BOOLEAN jjP2N(leftv res, leftv v)
4817{
4818  number n;
4819  poly p;
4820  if (((p=(poly)v->Data())!=NULL)
4821  && (pIsConstant(p)))
4822  {
4823    n=nCopy(pGetCoeff(p));
4824  }
4825  else
4826  {
4827    n=nInit(0);
4828  }
4829  res->data = (char *)n;
4830  return FALSE;
4831}
4832static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4833{
4834  char *s= (char *)v->Data();
4835  // try system keywords
4836  for(unsigned i=0; i<sArithBase.nCmdUsed; i++)
4837  {
4838    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4839    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4840    {
4841      res->data = (char *)1;
4842      return FALSE;
4843    }
4844  }
4845  // try blackbox names
4846  int id;
4847  blackboxIsCmd(s,id);
4848  if (id>0)
4849  {
4850    res->data = (char *)1;
4851  }
4852  return FALSE;
4853}
4854static BOOLEAN jjRANK1(leftv res, leftv v)
4855{
4856  matrix m =(matrix)v->Data();
4857  int rank = luRank(m, 0);
4858  res->data =(char *)(long)rank;
4859  return FALSE;
4860}
4861static BOOLEAN jjREAD(leftv res, leftv v)
4862{
4863  return jjREAD2(res,v,NULL);
4864}
4865static BOOLEAN jjREGULARITY(leftv res, leftv v)
4866{
4867  res->data = (char *)(long)iiRegularity((lists)v->Data());
4868  return FALSE;
4869}
4870static BOOLEAN jjREPART(leftv res, leftv v)
4871{
4872  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4873  return FALSE;
4874}
4875static BOOLEAN jjRINGLIST(leftv res, leftv v)
4876{
4877  ring r=(ring)v->Data();
4878  if (r!=NULL)
4879  {
4880    res->data = (char *)rDecompose((ring)v->Data());
4881    if (res->data!=NULL)
4882    {
4883      long mm=r->wanted_maxExp;
4884      if (mm!=0) atSet(res,omStrDup("maxExp"),(void*)mm,INT_CMD);
4885      return FALSE;
4886    }
4887  }
4888  return TRUE;
4889}
4890static BOOLEAN jjRINGLIST_C(leftv res, leftv v)
4891{
4892  coeffs r=(coeffs)v->Data();
4893  if (r!=NULL)
4894    return rDecompose_CF(res,r);
4895  return TRUE;
4896}
4897static BOOLEAN jjRING_LIST(leftv res, leftv v)
4898{
4899  ring r=(ring)v->Data();
4900  if (r!=NULL)
4901    res->data = (char *)rDecompose_list_cf((ring)v->Data());
4902  return (r==NULL)||(res->data==NULL);
4903}
4904static BOOLEAN jjROWS(leftv res, leftv v)
4905{
4906  ideal i = (ideal)v->Data();
4907  res->data = (char *)i->rank;
4908  return FALSE;
4909}
4910static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4911{
4912  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4913  return FALSE;
4914}
4915static BOOLEAN jjROWS_IV(leftv res, leftv v)
4916{
4917  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4918  return FALSE;
4919}
4920static BOOLEAN jjRPAR(leftv res, leftv v)
4921{
4922  res->data = (char *)(long)rPar(((ring)v->Data()));
4923  return FALSE;
4924}
4925static BOOLEAN jjS2I(leftv res, leftv v)
4926{
4927  res->data = (char *)(long)atoi((char*)v->Data());
4928  return FALSE;
4929}
4930static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4931{
4932  const bool bIsSCA = rIsSCA(currRing);
4933
4934  if ((currRing->qideal!=NULL) && !bIsSCA)
4935  {
4936    WerrorS("qring not supported by slimgb at the moment");
4937    return TRUE;
4938  }
4939  if (rHasLocalOrMixedOrdering(currRing))
4940  {
4941    WerrorS("ordering must be global for slimgb");
4942    return TRUE;
4943  }
4944  if (rField_is_numeric(currRing))
4945    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
4946  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4947  // tHomog hom=testHomog;
4948  ideal u_id=(ideal)u->Data();
4949  if (w!=NULL)
4950  {
4951    if (!idTestHomModule(u_id,currRing->qideal,w))
4952    {
4953      WarnS("wrong weights");
4954      w=NULL;
4955    }
4956    else
4957    {
4958      w=ivCopy(w);
4959      // hom=isHomog;
4960    }
4961  }
4962
4963  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4964  res->data=(char *)t_rep_gb(currRing,
4965    u_id,u_id->rank);
4966  //res->data=(char *)t_rep_gb(currRing, u_id);
4967
4968  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4969  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4970  return FALSE;
4971}
4972static BOOLEAN jjSBA(leftv res, leftv v)
4973{
4974  ideal result;
4975  ideal v_id=(ideal)v->Data();
4976  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4977  tHomog hom=testHomog;
4978  if (w!=NULL)
4979  {
4980    if (!idTestHomModule(v_id,currRing->qideal,w))
4981    {
4982      WarnS("wrong weights");
4983      w=NULL;
4984    }
4985    else
4986    {
4987      hom=isHomog;
4988      w=ivCopy(w);
4989    }
4990  }
4991  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4992  idSkipZeroes(result);
4993  res->data = (char *)result;
4994  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4995  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4996  return FALSE;
4997}
4998static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4999{
5000  ideal result;
5001  ideal v_id=(ideal)v->Data();
5002  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5003  tHomog hom=testHomog;
5004  if (w!=NULL)
5005  {
5006    if (!idTestHomModule(v_id,currRing->qideal,w))
5007    {
5008      WarnS("wrong weights");
5009      w=NULL;
5010    }
5011    else
5012    {
5013      hom=isHomog;
5014      w=ivCopy(w);
5015    }
5016  }
5017  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
5018  idSkipZeroes(result);
5019  res->data = (char *)result;
5020  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5021  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5022  return FALSE;
5023}
5024static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
5025{
5026  ideal result;
5027  ideal v_id=(ideal)v->Data();
5028  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5029  tHomog hom=testHomog;
5030  if (w!=NULL)
5031  {
5032    if (!idTestHomModule(v_id,currRing->qideal,w))
5033    {
5034      WarnS("wrong weights");
5035      w=NULL;
5036    }
5037    else
5038    {
5039      hom=isHomog;
5040      w=ivCopy(w);
5041    }
5042  }
5043  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
5044  idSkipZeroes(result);
5045  res->data = (char *)result;
5046  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5047  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5048  return FALSE;
5049}
5050static BOOLEAN jjSTD(leftv res, leftv v)
5051{
5052  if (rField_is_numeric(currRing))
5053    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5054  ideal result;
5055  ideal v_id=(ideal)v->Data();
5056  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5057  tHomog hom=testHomog;
5058  if (w!=NULL)
5059  {
5060    if (!idTestHomModule(v_id,currRing->qideal,w))
5061    {
5062      WarnS("wrong weights");
5063      w=NULL;
5064    }
5065    else
5066    {
5067      hom=isHomog;
5068      w=ivCopy(w);
5069    }
5070  }
5071  result=kStd(v_id,currRing->qideal,hom,&w);
5072  idSkipZeroes(result);
5073  res->data = (char *)result;
5074  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5075  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5076  return FALSE;
5077}
5078static BOOLEAN jjSort_Id(leftv res, leftv v)
5079{
5080  res->data = (char *)idSort((ideal)v->Data());
5081  return FALSE;
5082}
5083static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5084{
5085  singclap_factorize_retry=0;
5086  intvec *v=NULL;
5087  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5088  if (f==NULL) return TRUE;
5089  ivTest(v);
5090  lists l=(lists)omAllocBin(slists_bin);
5091  l->Init(2);
5092  l->m[0].rtyp=IDEAL_CMD;
5093  l->m[0].data=(void *)f;
5094  l->m[1].rtyp=INTVEC_CMD;
5095  l->m[1].data=(void *)v;
5096  res->data=(void *)l;
5097  return FALSE;
5098}
5099#if 0
5100static BOOLEAN jjSYZYGY(leftv res, leftv v)
5101{
5102  intvec *w=NULL;
5103  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5104  if (w!=NULL) delete w;
5105  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5106  return FALSE;
5107}
5108#else
5109// activate, if idSyz handle module weights correctly !
5110static BOOLEAN jjSYZYGY(leftv res, leftv v)
5111{
5112  ideal v_id=(ideal)v->Data();
5113#ifdef HAVE_SHIFTBBA
5114  if (rIsLPRing(currRing))
5115  {
5116    if (currRing->LPncGenCount < IDELEMS(v_id))
5117    {
5118      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS(v_id));
5119      return TRUE;
5120    }
5121  }
5122#endif
5123  intvec *ww=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5124  intvec *w=NULL;
5125  tHomog hom=testHomog;
5126  if (ww!=NULL)
5127  {
5128    if (idTestHomModule(v_id,currRing->qideal,ww))
5129    {
5130      w=ivCopy(ww);
5131      int add_row_shift=w->min_in();
5132      (*w)-=add_row_shift;
5133      hom=isHomog;
5134    }
5135    else
5136    {
5137      //WarnS("wrong weights");
5138      delete ww; ww=NULL;
5139      hom=testHomog;
5140    }
5141  }
5142  else
5143  {
5144    if (v->Typ()==IDEAL_CMD)
5145      if (idHomIdeal(v_id,currRing->qideal))
5146        hom=isHomog;
5147  }
5148  ideal S=idSyzygies(v_id,hom,&w);
5149  res->data = (char *)S;
5150  if (hom==isHomog)
5151  {
5152    int vl=S->rank;
5153    intvec *vv=new intvec(vl);
5154    if ((v->Typ()==IDEAL_CMD)||(ww==NULL))
5155    {
5156      for(int i=0;i<vl;i++)
5157      {
5158        if (v_id->m[i]!=NULL)
5159          (*vv)[i]=p_Deg(v_id->m[i],currRing);
5160      }
5161    }
5162    else
5163    {
5164      p_SetModDeg(ww, currRing);
5165      for(int i=0;i<vl;i++)
5166      {
5167        if (v_id->m[i]!=NULL)
5168          (*vv)[i]=currRing->pFDeg(v_id->m[i],currRing);
5169      }
5170      p_SetModDeg(NULL, currRing);
5171    }
5172    if (idTestHomModule(S,currRing->qideal,vv))
5173      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
5174    else
5175      delete vv;
5176  }
5177  if (w!=NULL) delete w;
5178  return FALSE;
5179}
5180#endif
5181static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5182{
5183  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5184  return FALSE;
5185}
5186static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5187{
5188  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5189  return FALSE;
5190}
5191static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5192{
5193  res->data = (char *)ivTranp((intvec*)(v->Data()));
5194  return FALSE;
5195}
5196static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5197{
5198#ifdef HAVE_PLURAL
5199  ring    r = (ring)a->Data();
5200  //if (rIsPluralRing(r))
5201  if (r->OrdSgn==1)
5202  {
5203    res->data = rOpposite(r);
5204  }
5205  else
5206  {
5207    WarnS("opposite only for global orderings");
5208    res->data = rCopy(r);
5209  }
5210  return FALSE;
5211#else
5212  return TRUE;
5213#endif
5214}
5215static BOOLEAN jjENVELOPE(leftv res, leftv a)
5216{
5217#ifdef HAVE_PLURAL
5218  ring    r = (ring)a->Data();
5219  if (rIsPluralRing(r))
5220  {
5221    ring s = rEnvelope(r);
5222    res->data = s;
5223  }
5224  else  res->data = rCopy(r);
5225  return FALSE;
5226#else
5227  return TRUE;
5228#endif
5229}
5230static BOOLEAN jjTWOSTD(leftv res, leftv a)
5231{
5232#ifdef HAVE_PLURAL
5233  ideal result;
5234  ideal v_id=(ideal)a->Data();
5235  if (rIsPluralRing(currRing))
5236    result=(ideal)twostd(v_id);
5237  else /*commutative or shiftalgebra*/
5238  {
5239    return jjSTD(res,a);
5240  }
5241  res->data = (char *)result;
5242  setFlag(res,FLAG_STD);
5243  setFlag(res,FLAG_TWOSTD);
5244  return FALSE;
5245#else
5246  return TRUE;
5247#endif
5248}
5249static BOOLEAN jjRIGHTSTD(leftv res, leftv v)
5250{
5251#if defined(HAVE_SHIFTBBA) || defined(HAVE_PLURAL)// do not place above jjSTD in this file because we need to reference it
5252  if (rIsLPRing(currRing))
5253  {
5254    if (rField_is_numeric(currRing))
5255      WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5256    ideal result;
5257    ideal v_id=(ideal)v->Data();
5258    /* intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD); */
5259    /* tHomog hom=testHomog; */
5260    /* if (w!=NULL) */
5261    /* { */
5262    /*   if (!idTestHomModule(v_id,currRing->qideal,w)) */
5263    /*   { */
5264    /*     WarnS("wrong weights"); */
5265    /*     w=NULL; */
5266    /*   } */
5267    /*   else */
5268    /*   { */
5269    /*     hom=isHomog; */
5270    /*     w=ivCopy(w); */
5271    /*   } */
5272    /* } */
5273    /* result=kStd(v_id,currRing->qideal,hom,&w); */
5274    result = rightgb(v_id, currRing->qideal);
5275    idSkipZeroes(result);
5276    res->data = (char *)result;
5277    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5278    /* if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD); */
5279    return FALSE;
5280  }
5281  else if (rIsPluralRing(currRing))
5282  {
5283    ideal I=(ideal)v->Data();
5284
5285    ring A = currRing;
5286    ring Aopp = rOpposite(A);
5287    currRing = Aopp;
5288    ideal Iopp = idOppose(A, I, Aopp);
5289    ideal Jopp = kStd(Iopp,currRing->qideal,testHomog,NULL);
5290    currRing = A;
5291    ideal J = idOppose(Aopp, Jopp, A);
5292
5293    id_Delete(&Iopp, Aopp);
5294    id_Delete(&Jopp, Aopp);
5295    rDelete(Aopp);
5296
5297    idSkipZeroes(J);
5298    res->data = (char *)J;
5299    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5300    return FALSE;
5301  }
5302  else
5303  {
5304    return jjSTD(res, v);
5305  }
5306#else
5307  return TRUE;
5308#endif
5309}
5310static BOOLEAN jjTYPEOF(leftv res, leftv v)
5311{
5312  int t=(int)(long)v->data;
5313  switch (t)
5314  {
5315    case CRING_CMD:
5316    case INT_CMD:
5317    case POLY_CMD:
5318    case VECTOR_CMD:
5319    case STRING_CMD:
5320    case INTVEC_CMD:
5321    case IDEAL_CMD:
5322    case MATRIX_CMD:
5323    case MODUL_CMD:
5324    case MAP_CMD:
5325    case PROC_CMD:
5326    case RING_CMD:
5327    case SMATRIX_CMD:
5328    //case QRING_CMD:
5329    case INTMAT_CMD:
5330    case BIGINTMAT_CMD:
5331    case NUMBER_CMD:
5332    #ifdef SINGULAR_4_2
5333    case CNUMBER_CMD:
5334    #endif
5335    case BIGINT_CMD:
5336    case BUCKET_CMD:
5337    case LIST_CMD:
5338    case PACKAGE_CMD:
5339    case LINK_CMD:
5340    case RESOLUTION_CMD:
5341         res->data=omStrDup(Tok2Cmdname(t)); break;
5342    case DEF_CMD:
5343    case NONE:           res->data=omStrDup("none"); break;
5344    default:
5345    {
5346      if (t>MAX_TOK)
5347        res->data=omStrDup(getBlackboxName(t));
5348      else
5349        res->data=omStrDup("?unknown type?");
5350      break;
5351    }
5352  }
5353  return FALSE;
5354}
5355static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5356{
5357  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5358  return FALSE;
5359}
5360static BOOLEAN jjVAR1(leftv res, leftv v)
5361{
5362  int i=(int)(long)v->Data();
5363  if ((0<i) && (i<=currRing->N))
5364  {
5365    poly p=pOne();
5366    pSetExp(p,i,1);
5367    pSetm(p);
5368    res->data=(char *)p;
5369  }
5370  else
5371  {
5372    Werror("var number %d out of range 1..%d",i,currRing->N);
5373    return TRUE;
5374  }
5375  return FALSE;
5376}
5377static BOOLEAN jjVARSTR1(leftv res, leftv v)
5378{
5379  if (currRing==NULL)
5380  {
5381    WerrorS("no ring active (2)");
5382    return TRUE;
5383  }
5384  int i=(int)(long)v->Data();
5385  if ((0<i) && (i<=currRing->N))
5386    res->data=omStrDup(currRing->names[i-1]);
5387  else
5388  {
5389    Werror("var number %d out of range 1..%d",i,currRing->N);
5390    return TRUE;
5391  }
5392  return FALSE;
5393}
5394static BOOLEAN jjVDIM(leftv res, leftv v)
5395{
5396  assumeStdFlag(v);
5397#ifdef HAVE_SHIFTBBA
5398  if (rIsLPRing(currRing))
5399  {
5400#ifdef HAVE_RINGS
5401    if (rField_is_Ring(currRing))
5402    {
5403      WerrorS("`vdim` is not implemented for letterplace rings over rings");
5404      return TRUE;
5405    }
5406#endif
5407    if (currRing->qideal != NULL)
5408    {
5409      WerrorS("qring not supported by `vdim` for letterplace rings at the moment");
5410      return TRUE;
5411    }
5412    int kDim = lp_kDim((ideal)(v->Data()));
5413    res->data = (char *)(long)kDim;
5414    return (kDim == -2);
5415  }
5416#endif
5417  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5418  return FALSE;
5419}
5420BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5421{
5422// input: u: a list with links of type
5423//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5424// returns: -1:  the read state of all links is eof
5425//          i>0: (at least) u[i] is ready
5426  lists Lforks = (lists)u->Data();
5427  int i = slStatusSsiL(Lforks, -1);
5428  if(i == -2) /* error */
5429  {
5430    return TRUE;
5431  }
5432  res->data = (void*)(long)i;
5433  return FALSE;
5434}
5435BOOLEAN jjWAITALL1(leftv res, leftv u)
5436{
5437// input: u: a list with links of type
5438//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5439// returns: -1: the read state of all links is eof
5440//           1: all links are ready
5441//              (caution: at least one is ready, but some maybe dead)
5442  lists Lforks = (lists)u->CopyD();
5443  int i;
5444  int j = -1;
5445  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5446  {
5447    i = slStatusSsiL(Lforks, -1);
5448    if(i == -2) /* error */
5449    {
5450      return TRUE;
5451    }
5452    if(i == -1)
5453    {
5454      break;
5455    }
5456    j = 1;
5457    Lforks->m[i-1].CleanUp();
5458    Lforks->m[i-1].rtyp=DEF_CMD;
5459    Lforks->m[i-1].data=NULL;
5460  }
5461  res->data = (void*)(long)j;
5462  Lforks->Clean();
5463  return FALSE;
5464}
5465
5466BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5467{
5468  char libnamebuf[1024];
5469  lib_types LT = type_of_LIB(s, libnamebuf);
5470
5471#ifdef HAVE_DYNAMIC_LOADING
5472  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5473#endif /* HAVE_DYNAMIC_LOADING */
5474  switch(LT)
5475  {
5476      default:
5477      case LT_NONE:
5478        Werror("%s: unknown type", s);
5479        break;
5480      case LT_NOTFOUND:
5481        Werror("cannot open %s", s);
5482        break;
5483
5484      case LT_SINGULAR:
5485      {
5486        char *plib = iiConvName(s);
5487        idhdl pl = IDROOT->get_level(plib,0);
5488        if (pl==NULL)
5489        {
5490          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5491          IDPACKAGE(pl)->language = LANG_SINGULAR;
5492          IDPACKAGE(pl)->libname=omStrDup(s);
5493        }
5494        else if (IDTYP(pl)!=PACKAGE_CMD)
5495        {
5496          Werror("can not create package `%s`",plib);
5497          omFree(plib);
5498          return TRUE;
5499        }
5500        else /* package */
5501        {
5502          package pa=IDPACKAGE(pl);
5503          if ((pa->language==LANG_C)
5504          || (pa->language==LANG_MIX))
5505          {
5506            Werror("can not create package `%s` - binaries  exists",plib);
5507            omfree(plib);
5508            return TRUE;
5509          }
5510        }
5511        omFree(plib);
5512        package savepack=currPack;
5513        currPack=IDPACKAGE(pl);
5514        IDPACKAGE(pl)->loaded=TRUE;
5515        char libnamebuf[1024];
5516        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5517        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5518        currPack=savepack;
5519        IDPACKAGE(pl)->loaded=(!bo);
5520        return bo;
5521      }
5522      case LT_BUILTIN:
5523        SModulFunc_t iiGetBuiltinModInit(const char*);
5524        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5525      case LT_MACH_O:
5526      case LT_ELF:
5527      case LT_HPUX:
5528#ifdef HAVE_DYNAMIC_LOADING
5529        return load_modules(s, libnamebuf, autoexport);
5530#else /* HAVE_DYNAMIC_LOADING */
5531        WerrorS("Dynamic modules are not supported by this version of Singular");
5532        break;
5533#endif /* HAVE_DYNAMIC_LOADING */
5534  }
5535  return TRUE;
5536}
5537STATIC_VAR int WerrorS_dummy_cnt=0;
5538static void WerrorS_dummy(const char *)
5539{
5540  WerrorS_dummy_cnt++;
5541}
5542BOOLEAN jjLOAD_TRY(const char *s)
5543{
5544  if (!iiGetLibStatus(s))
5545  {
5546    void (*WerrorS_save)(const char *s) = WerrorS_callback;
5547    WerrorS_callback=WerrorS_dummy;
5548    WerrorS_dummy_cnt=0;
5549    BOOLEAN bo=jjLOAD(s,TRUE);
5550    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5551      Print("loading of >%s< failed\n",s);
5552    WerrorS_callback=WerrorS_save;
5553    errorreported=0;
5554  }
5555  return FALSE;
5556}
5557
5558static BOOLEAN jjstrlen(leftv res, leftv v)
5559{
5560  res->data = (char *)strlen((char *)v->Data());
5561  return FALSE;
5562}
5563static BOOLEAN jjpLength(leftv res, leftv v)
5564{
5565  res->data = (char *)(long)pLength((poly)v->Data());
5566  return FALSE;
5567}
5568static BOOLEAN jjidElem(leftv res, leftv v)
5569{
5570  res->data = (char *)(long)idElem((ideal)v->Data());
5571  return FALSE;
5572}
5573static BOOLEAN jjidFreeModule(leftv res, leftv v)
5574{
5575  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5576  return FALSE;
5577}
5578static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5579{
5580  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5581  return FALSE;
5582}
5583static BOOLEAN jjrCharStr(leftv res, leftv v)
5584{
5585  res->data = rCharStr((ring)v->Data());
5586  return FALSE;
5587}
5588static BOOLEAN jjpHead(leftv res, leftv v)
5589{
5590  res->data = (char *)pHead((poly)v->Data());
5591  return FALSE;
5592}
5593static BOOLEAN jjidHead(leftv res, leftv v)
5594{
5595  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5596  setFlag(res,FLAG_STD);
5597  return FALSE;
5598}
5599static BOOLEAN jjidMinBase(leftv res, leftv v)
5600{
5601  res->data = (char *)idMinBase((ideal)v->Data());
5602  return FALSE;
5603}
5604#if 0 // unused
5605static BOOLEAN jjsyMinBase(leftv res, leftv v)
5606{
5607  res->data = (char *)syMinBase((ideal)v->Data());
5608  return FALSE;
5609}
5610#endif
5611static BOOLEAN jjpMaxComp(leftv res, leftv v)
5612{
5613  res->data = (char *)pMaxComp((poly)v->Data());
5614  return FALSE;
5615}
5616static BOOLEAN jjmpTrace(leftv res, leftv v)
5617{
5618  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5619  return FALSE;
5620}
5621static BOOLEAN jjmpTransp(leftv res, leftv v)
5622{
5623  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5624  return FALSE;
5625}
5626static BOOLEAN jjrOrdStr(leftv res, leftv v)
5627{
5628  res->data = rOrdStr((ring)v->Data());
5629  return FALSE;
5630}
5631static BOOLEAN jjrVarStr(leftv res, leftv v)
5632{
5633  res->data = rVarStr((ring)v->Data());
5634  return FALSE;
5635}
5636static BOOLEAN jjrParStr(leftv res, leftv v)
5637{
5638  res->data = rParStr((ring)v->Data());
5639  return FALSE;
5640}
5641static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5642{
5643  res->data=(char *)(long)sySize((syStrategy)v->Data());
5644  return FALSE;
5645}
5646static BOOLEAN jjDIM_R(leftv res, leftv v)
5647{
5648  res->data = (char *)(long)syDim((syStrategy)v->Data());
5649  return FALSE;
5650}
5651static BOOLEAN jjidTransp(leftv res, leftv v)
5652{
5653  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5654  return FALSE;
5655}
5656static BOOLEAN jjnInt(leftv res, leftv u)
5657{
5658  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5659  res->data=(char *)(long)iin_Int(n,currRing->cf);
5660  n_Delete(&n,currRing->cf);
5661  return FALSE;
5662}
5663static BOOLEAN jjnlInt(leftv res, leftv u)
5664{
5665  number n=(number)u->Data();
5666  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5667  return FALSE;
5668}
5669/*=================== operations with 3 args.: static proc =================*/
5670/* must be ordered: first operations for chars (infix ops),
5671 * then alphabetically */
5672static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5673{
5674  char *s= (char *)u->Data();
5675  int   r = (int)(long)v->Data();
5676  int   c = (int)(long)w->Data();
5677  int l = strlen(s);
5678
5679  if ( (r<1) || (r>l) || (c<0) )
5680  {
5681    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5682    return TRUE;
5683  }
5684  res->data = (char *)omAlloc((long)(c+1));
5685  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5686  return FALSE;
5687}
5688static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5689{
5690  intvec *iv = (intvec *)u->Data();
5691  int   r = (int)(long)v->Data();
5692  int   c = (int)(long)w->Data();
5693  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5694  {
5695    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5696           r,c,u->Fullname(),iv->rows(),iv->cols());
5697    return TRUE;
5698  }
5699  res->data=u->data; u->data=NULL;
5700  res->rtyp=u->rtyp; u->rtyp=0;
5701  res->name=u->name; u->name=NULL;
5702  Subexpr e=jjMakeSub(v);
5703          e->next=jjMakeSub(w);
5704  if (u->e==NULL) res->e=e;
5705  else
5706  {
5707    Subexpr h=u->e;
5708    while (h->next!=NULL) h=h->next;
5709    h->next=e;
5710    res->e=u->e;
5711    u->e=NULL;
5712  }
5713  return FALSE;
5714}
5715static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5716{
5717  bigintmat *bim = (bigintmat *)u->Data();
5718  int   r = (int)(long)v->Data();
5719  int   c = (int)(long)w->Data();
5720  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5721  {
5722    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5723           r,c,u->Fullname(),bim->rows(),bim->cols());
5724    return TRUE;
5725  }
5726  res->data=u->data; u->data=NULL;
5727  res->rtyp=u->rtyp; u->rtyp=0;
5728  res->name=u->name; u->name=NULL;
5729  Subexpr e=jjMakeSub(v);
5730          e->next=jjMakeSub(w);
5731  if (u->e==NULL)
5732    res->e=e;
5733  else
5734  {
5735    Subexpr h=u->e;
5736    while (h->next!=NULL) h=h->next;
5737    h->next=e;
5738    res->e=u->e;
5739    u->e=NULL;
5740  }
5741  return FALSE;
5742}
5743static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5744{
5745  matrix m= (matrix)u->Data();
5746  int   r = (int)(long)v->Data();
5747  int   c = (int)(long)w->Data();
5748  //Print("gen. elem %d, %d\n",r,c);
5749  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5750  {
5751    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5752      MATROWS(m),MATCOLS(m));
5753    return TRUE;
5754  }
5755  res->data=u->data; u->data=NULL;
5756  res->rtyp=u->rtyp; u->rtyp=0;
5757  res->name=u->name; u->name=NULL;
5758  Subexpr e=jjMakeSub(v);
5759          e->next=jjMakeSub(w);
5760  if (u->e==NULL)
5761    res->e=e;
5762  else
5763  {
5764    Subexpr h=u->e;
5765    while (h->next!=NULL) h=h->next;
5766    h->next=e;
5767    res->e=u->e;
5768    u->e=NULL;
5769  }
5770  return FALSE;
5771}
5772static BOOLEAN jjBRACK_SM(leftv res, leftv u, leftv v,leftv w)
5773{
5774  ideal m= (ideal)u->Data();
5775  int   r = (int)(long)v->Data();
5776  int   c = (int)(long)w->Data();
5777  //Print("gen. elem %d, %d\n",r,c);
5778  if ((r<1)||(r>m->rank)||(c<1)||(c>IDELEMS(m)))
5779  {
5780    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5781      (int)m->rank,IDELEMS(m));
5782    return TRUE;
5783  }
5784  res->data=u->data; u->data=NULL;
5785  res->rtyp=u->rtyp; u->rtyp=0;
5786  res->name=u->name; u->name=NULL;
5787  Subexpr e=jjMakeSub(v);
5788          e->next=jjMakeSub(w);
5789  if (u->e==NULL)
5790    res->e=e;
5791  else
5792  {
5793    Subexpr h=u->e;
5794    while (h->next!=NULL) h=h->next;
5795    h->next=e;
5796    res->e=u->e;
5797    u->e=NULL;
5798  }
5799  return FALSE;
5800}
5801static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5802{
5803  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5804  {
5805    WerrorS("cannot build expression lists from unnamed objects");
5806    return TRUE;
5807  }
5808
5809  leftv p=NULL;
5810  intvec *iv=(intvec *)w->Data();
5811  int l;
5812  BOOLEAN nok;
5813  sleftv ut;
5814  memcpy(&ut,u,sizeof(ut));
5815  sleftv t;
5816  t.Init();
5817  t.rtyp=INT_CMD;
5818  for (l=0;l< iv->length(); l++)
5819  {
5820    t.data=(char *)(long)((*iv)[l]);
5821    if (p==NULL)
5822    {
5823      p=res;
5824    }
5825    else
5826    {
5827      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5828      p=p->next;
5829    }
5830    memcpy(u,&ut,sizeof(ut));
5831    if (u->Typ() == MATRIX_CMD)
5832      nok=jjBRACK_Ma(p,u,v,&t);
5833    else if (u->Typ() == BIGINTMAT_CMD)
5834      nok=jjBRACK_Bim(p,u,v,&t);
5835    else /* INTMAT_CMD */
5836      nok=jjBRACK_Im(p,u,v,&t);
5837    if (nok)
5838    {
5839      while (res->next!=NULL)
5840      {
5841        p=res->next->next;
5842        omFreeBin((ADDRESS)res->next, sleftv_bin);
5843        // res->e aufraeumen !!!!
5844        res->next=p;
5845      }
5846      return TRUE;
5847    }
5848  }
5849  return FALSE;
5850}
5851static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5852{
5853  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5854  {
5855    WerrorS("cannot build expression lists from unnamed objects");
5856    return TRUE;
5857  }
5858  leftv p=NULL;
5859  intvec *iv=(intvec *)v->Data();
5860  int l;
5861  BOOLEAN nok;
5862  sleftv ut;
5863  memcpy(&ut,u,sizeof(ut));
5864  sleftv t;
5865  t.Init();
5866  t.rtyp=INT_CMD;
5867  for (l=0;l< iv->length(); l++)
5868  {
5869    t.data=(char *)(long)((*iv)[l]);
5870    if (p==NULL)
5871    {
5872      p=res;
5873    }
5874    else
5875    {
5876      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5877      p=p->next;
5878    }
5879    memcpy(u,&ut,sizeof(ut));
5880    if (u->Typ() == MATRIX_CMD)
5881      nok=jjBRACK_Ma(p,u,&t,w);
5882    else if (u->Typ() == BIGINTMAT_CMD)
5883      nok=jjBRACK_Bim(p,u,&t,w);
5884    else /* INTMAT_CMD */
5885      nok=jjBRACK_Im(p,u,&t,w);
5886    if (nok)
5887    {
5888      while (res->next!=NULL)
5889      {
5890        p=res->next->next;
5891        omFreeBin((ADDRESS)res->next, sleftv_bin);
5892        // res->e aufraeumen !!
5893        res->next=p;
5894      }
5895      return TRUE;
5896    }
5897  }
5898  return FALSE;
5899}
5900static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5901{
5902  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5903  {
5904    WerrorS("cannot build expression lists from unnamed objects");
5905    return TRUE;
5906  }
5907  leftv p=NULL;
5908  intvec *vv=(intvec *)v->Data();
5909  intvec *wv=(intvec *)w->Data();
5910  int vl;
5911  int wl;
5912  BOOLEAN nok;
5913
5914  sleftv t1,t2,ut;
5915  memcpy(&ut,u,sizeof(ut));
5916  t1.Init();
5917  t1.rtyp=INT_CMD;
5918  t2.Init();
5919  t2.rtyp=INT_CMD;
5920  for (vl=0;vl< vv->length(); vl++)
5921  {
5922    t1.data=(char *)(long)((*vv)[vl]);
5923    for (wl=0;wl< wv->length(); wl++)
5924    {
5925      t2.data=(char *)(long)((*wv)[wl]);
5926      if (p==NULL)
5927      {
5928        p=res;
5929      }
5930      else
5931      {
5932        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5933        p=p->next;
5934      }
5935      memcpy(u,&ut,sizeof(ut));
5936      if (u->Typ() == MATRIX_CMD)
5937        nok=jjBRACK_Ma(p,u,&t1,&t2);
5938      else if (u->Typ() == BIGINTMAT_CMD)
5939        nok=jjBRACK_Bim(p,u,&t1,&t2);
5940      else /* INTMAT_CMD */
5941        nok=jjBRACK_Im(p,u,&t1,&t2);
5942      if (nok)
5943      {
5944        res->CleanUp();
5945        return TRUE;
5946      }
5947    }
5948  }
5949  return FALSE;
5950}
5951static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5952{
5953  v->next=(leftv)omAllocBin(sleftv_bin);
5954  memcpy(v->next,w,sizeof(sleftv));
5955  w->Init();
5956  return jjPROC(res,u,v);
5957}
5958static BOOLEAN jjRING_2(leftv res, leftv u, leftv v, leftv w)
5959{
5960  u->next=(leftv)omAlloc(sizeof(sleftv));
5961  memcpy(u->next,v,sizeof(sleftv));
5962  v->Init();
5963  u->next->next=(leftv)omAlloc(sizeof(sleftv));
5964  memcpy(u->next->next,w,sizeof(sleftv));
5965  w->Init();
5966  BOOLEAN bo=iiExprArithM(res,u,'[');
5967  u->next=NULL;
5968  return bo;
5969}
5970static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5971{
5972  intvec *iv;
5973  ideal m;
5974  lists l=(lists)omAllocBin(slists_bin);
5975  int k=(int)(long)w->Data();
5976  if (k>=0)
5977  {
5978    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5979    l->Init(2);
5980    l->m[0].rtyp=MODUL_CMD;
5981    l->m[1].rtyp=INTVEC_CMD;
5982    l->m[0].data=(void *)m;
5983    l->m[1].data=(void *)iv;
5984  }
5985  else
5986  {
5987    m=sm_CallSolv((ideal)u->Data(), currRing);
5988    l->Init(1);
5989    l->m[0].rtyp=IDEAL_CMD;
5990    l->m[0].data=(void *)m;
5991  }
5992  res->data = (char *)l;
5993  return FALSE;
5994}
5995static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5996{
5997  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5998  {
5999    WerrorS("3rd argument must be a name of a matrix");
6000    return TRUE;
6001  }
6002  ideal i=(ideal)u->Data();
6003  int rank=(int)i->rank;
6004  BOOLEAN r=jjCOEFFS_Id(res,u,v);
6005  if (r) return TRUE;
6006  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
6007  return FALSE;
6008}
6009static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
6010{
6011  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
6012           (ideal)(v->Data()),(poly)(w->Data()));
6013  return FALSE;
6014}
6015static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
6016{
6017  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
6018  {
6019    WerrorS("3rd argument must be a name of a matrix");
6020    return TRUE;
6021  }
6022  // CopyD for POLY_CMD and VECTOR_CMD are identical:
6023  poly p=(poly)u->CopyD(POLY_CMD);
6024  ideal i=idInit(1,1);
6025  i->m[0]=p;
6026  sleftv t;
6027  t.Init();
6028  t.data=(char *)i;
6029  t.rtyp=IDEAL_CMD;
6030  int rank=1;
6031  if (u->Typ()==VECTOR_CMD)
6032  {
6033    i->rank=rank=pMaxComp(p);
6034    t.rtyp=MODUL_CMD;
6035  }
6036  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
6037  t.CleanUp();
6038  if (r) return TRUE;
6039  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
6040  return FALSE;
6041}
6042static BOOLEAN jjELIMIN_ALG(leftv res, leftv u, leftv v, leftv w)
6043{
6044  ideal I=(ideal)u->Data();
6045  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6046  res->data=(char *)idElimination(I,(poly)v->Data(),NULL,alg);
6047  //setFlag(res,FLAG_STD);
6048  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
6049}
6050static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
6051{
6052  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
6053    (intvec *)w->Data());
6054  //setFlag(res,FLAG_STD);
6055  return FALSE;
6056}
6057static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
6058{
6059  /*4
6060  * look for the substring what in the string where
6061  * starting at position n
6062  * return the position of the first char of what in where
6063  * or 0
6064  */
6065  int n=(int)(long)w->Data();
6066  char *where=(char *)u->Data();
6067  char *what=(char *)v->Data();
6068  char *found;
6069  if ((1>n)||(n>(int)strlen(where)))
6070  {
6071    Werror("start position %d out of range",n);
6072    return TRUE;
6073  }
6074  found = strchr(where+n-1,*what);
6075  if (*(what+1)!='\0')
6076  {
6077    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
6078    {
6079      found=strchr(found+1,*what);
6080    }
6081  }
6082  if (found != NULL)
6083  {
6084    res->data=(char *)((found-where)+1);
6085  }
6086  return FALSE;
6087}
6088static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
6089{
6090  if ((int)(long)w->Data()==0)
6091    res->data=(char *)walkProc(u,v);
6092  else
6093    res->data=(char *)fractalWalkProc(u,v);
6094  setFlag( res, FLAG_STD );
6095  return FALSE;
6096}
6097static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
6098{
6099  intvec *wdegree=(intvec*)w->Data();
6100  if (wdegree->length()!=currRing->N)
6101  {
6102    Werror("weight vector must have size %d, not %d",
6103           currRing->N,wdegree->length());
6104    return TRUE;
6105  }
6106#ifdef HAVE_RINGS
6107  if (rField_is_Z(currRing))
6108  {
6109    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
6110    PrintS("//       performed for generic fibre, that is, over Q\n");
6111  }
6112#endif
6113  assumeStdFlag(u);
6114  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6115  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
6116  if (errorreported) return TRUE;
6117
6118  switch((int)(long)v->Data())
6119  {
6120    case 1:
6121      res->data=(void *)iv;
6122      return FALSE;
6123    case 2:
6124      res->data=(void *)hSecondSeries(iv);
6125      delete iv;
6126      return FALSE;
6127  }
6128  delete iv;
6129  WerrorS(feNotImplemented);
6130  return TRUE;
6131}
6132static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
6133{
6134  PrintS("TODO\n");
6135  int i=pVar((poly)v->Data());
6136  if (i==0)
6137  {
6138    WerrorS("ringvar expected");
6139    return TRUE;
6140  }
6141  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6142  int d=pWTotaldegree(p);
6143  pLmDelete(p);
6144  if (d==1)
6145    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
6146  else
6147    WerrorS("variable must have weight 1");
6148  return (d!=1);
6149}
6150static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
6151{
6152  PrintS("TODO\n");
6153  int i=pVar((poly)v->Data());
6154  if (i==0)
6155  {
6156    WerrorS("ringvar expected");
6157    return TRUE;
6158  }
6159  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6160  int d=pWTotaldegree(p);
6161  pLmDelete(p);
6162  if (d==1)
6163    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
6164  else
6165    WerrorS("variable must have weight 1");
6166  return (d!=1);
6167}
6168static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
6169{
6170  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
6171  intvec* arg = (intvec*) u->Data();
6172  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
6173
6174  for (i=0; i<n; i++)
6175  {
6176    (*im)[i] = (*arg)[i];
6177  }
6178
6179  res->data = (char *)im;
6180  return FALSE;
6181}
6182static BOOLEAN jjINTERSECT3(leftv res, leftv u, leftv v, leftv w)
6183{
6184  ideal I1=(ideal)u->Data();
6185  ideal I2=(ideal)v->Data();
6186  ideal I3=(ideal)w->Data();
6187  resolvente r=(resolvente)omAlloc0(3*sizeof(ideal));
6188  r[0]=I1;
6189  r[1]=I2;
6190  r[2]=I3;
6191  res->data=(char *)idMultSect(r,3);
6192  omFreeSize((ADDRESS)r,3*sizeof(ideal));
6193  return FALSE;
6194}
6195static BOOLEAN jjINTERSEC3S(leftv res, leftv u, leftv v, leftv w)
6196{
6197  ideal I=(ideal)u->Data();
6198  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6199  res->data=(char *)idSect(I,(ideal)v->Data(),alg);
6200  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6201  return FALSE;
6202}
6203static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
6204{
6205  int *iw=iv2array((intvec *)w->Data(),currRing);
6206  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
6207  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(int) );
6208  return FALSE;
6209}
6210static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
6211{
6212  if (!pIsUnit((poly)v->Data()))
6213  {
6214    WerrorS("2nd argument must be a unit");
6215    return TRUE;
6216  }
6217  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
6218  return FALSE;
6219}
6220static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
6221{
6222  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
6223                             (intvec *)w->Data(),currRing);
6224  return FALSE;
6225}
6226static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6227{
6228  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6229  {
6230    WerrorS("2nd argument must be a diagonal matrix of units");
6231    return TRUE;
6232  }
6233  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6234                               (matrix)v->CopyD());
6235  return FALSE;
6236}
6237static BOOLEAN jjMINOR_M(leftv res, leftv v)
6238{
6239  /* Here's the use pattern for the minor command:
6240        minor ( matrix_expression m, int_expression minorSize,
6241                optional ideal_expression IasSB, optional int_expression k,
6242                optional string_expression algorithm,
6243                optional int_expression cachedMinors,
6244                optional int_expression cachedMonomials )
6245     This method here assumes that there are at least two arguments.
6246     - If IasSB is present, it must be a std basis. All minors will be
6247       reduced w.r.t. IasSB.
6248     - If k is absent, all non-zero minors will be computed.
6249       If k is present and k > 0, the first k non-zero minors will be
6250       computed.
6251       If k is present and k < 0, the first |k| minors (some of which
6252       may be zero) will be computed.
6253       If k is present and k = 0, an error is reported.
6254     - If algorithm is absent, all the following arguments must be absent too.
6255       In this case, a heuristic picks the best-suited algorithm (among
6256       Bareiss, Laplace, and Laplace with caching).
6257       If algorithm is present, it must be one of "Bareiss", "bareiss",
6258       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6259       "cache" two more arguments may be given, determining how many entries
6260       the cache may have at most, and how many cached monomials there are at
6261       most. (Cached monomials are counted over all cached polynomials.)
6262       If these two additional arguments are not provided, 200 and 100000
6263       will be used as defaults.
6264  */
6265  matrix m;
6266  leftv u=v->next;
6267  v->next=NULL;
6268  int v_typ=v->Typ();
6269  if (v_typ==MATRIX_CMD)
6270  {
6271     m = (const matrix)v->Data();
6272  }
6273  else
6274  {
6275    if (v_typ==0)
6276    {
6277      Werror("`%s` is undefined",v->Fullname());
6278      return TRUE;
6279    }
6280    // try to convert to MATRIX:
6281    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6282    BOOLEAN bo;
6283    sleftv tmp;
6284    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6285    else bo=TRUE;
6286    if (bo)
6287    {
6288      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6289      return TRUE;
6290    }
6291    m=(matrix)tmp.data;
6292  }
6293  const int mk = (const int)(long)u->Data();
6294  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6295  bool noCacheMinors = true; bool noCacheMonomials = true;
6296  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6297
6298  /* here come the different cases of correct argument sets */
6299  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6300  {
6301    IasSB = (ideal)u->next->Data();
6302    noIdeal = false;
6303    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6304    {
6305      k = (int)(long)u->next->next->Data();
6306      noK = false;
6307      if ((u->next->next->next != NULL) &&
6308          (u->next->next->next->Typ() == STRING_CMD))
6309      {
6310        algorithm = (char*)u->next->next->next->Data();
6311        noAlgorithm = false;
6312        if ((u->next->next->next->next != NULL) &&
6313            (u->next->next->next->next->Typ() == INT_CMD))
6314        {
6315          cacheMinors = (int)(long)u->next->next->next->next->Data();
6316          noCacheMinors = false;
6317          if ((u->next->next->next->next->next != NULL) &&
6318              (u->next->next->next->next->next->Typ() == INT_CMD))
6319          {
6320            cacheMonomials =
6321               (int)(long)u->next->next->next->next->next->Data();
6322            noCacheMonomials = false;
6323          }
6324        }
6325      }
6326    }
6327  }
6328  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6329  {
6330    k = (int)(long)u->next->Data();
6331    noK = false;
6332    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6333    {
6334      algorithm = (char*)u->next->next->Data();
6335      noAlgorithm = false;
6336      if ((u->next->next->next != NULL) &&
6337          (u->next->next->next->Typ() == INT_CMD))
6338      {
6339        cacheMinors = (int)(long)u->next->next->next->Data();
6340        noCacheMinors = false;
6341        if ((u->next->next->next->next != NULL) &&
6342            (u->next->next->next->next->Typ() == INT_CMD))
6343        {
6344          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6345          noCacheMonomials = false;
6346        }
6347      }
6348    }
6349  }
6350  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6351  {
6352    algorithm = (char*)u->next->Data();
6353    noAlgorithm = false;
6354    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6355    {
6356      cacheMinors = (int)(long)u->next->next->Data();
6357      noCacheMinors = false;
6358      if ((u->next->next->next != NULL) &&
6359          (u->next->next->next->Typ() == INT_CMD))
6360      {
6361        cacheMonomials = (int)(long)u->next->next->next->Data();
6362        noCacheMonomials = false;
6363      }
6364    }
6365  }
6366
6367  /* upper case conversion for the algorithm if present */
6368  if (!noAlgorithm)
6369  {
6370    if (strcmp(algorithm, "bareiss") == 0)
6371      algorithm = (char*)"Bareiss";
6372    if (strcmp(algorithm, "laplace") == 0)
6373      algorithm = (char*)"Laplace";
6374    if (strcmp(algorithm, "cache") == 0)
6375      algorithm = (char*)"Cache";
6376  }
6377
6378  v->next=u;
6379  /* here come some tests */
6380  if (!noIdeal)
6381  {
6382    assumeStdFlag(u->next);
6383  }
6384  if ((!noK) && (k == 0))
6385  {
6386    WerrorS("Provided number of minors to be computed is zero.");
6387    return TRUE;
6388  }
6389  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6390      && (strcmp(algorithm, "Laplace") != 0)
6391      && (strcmp(algorithm, "Cache") != 0))
6392  {
6393    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6394    return TRUE;
6395  }
6396  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6397      && (!rField_is_Domain(currRing)))
6398  {
6399    Werror("Bareiss algorithm not defined over coefficient rings %s",
6400           "with zero divisors.");
6401    return TRUE;
6402  }
6403  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6404  {
6405    ideal I=idInit(1,1);
6406    if (mk<1) I->m[0]=p_One(currRing);
6407    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6408    //       m->rows(), m->cols());
6409    res->data=(void*)I;
6410    return FALSE;
6411  }
6412  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6413      && (noCacheMinors || noCacheMonomials))
6414  {
6415    cacheMinors = 200;
6416    cacheMonomials = 100000;
6417  }
6418
6419  /* here come the actual procedure calls */
6420  if (noAlgorithm)
6421    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6422                                       (noIdeal ? 0 : IasSB), false);
6423  else if (strcmp(algorithm, "Cache") == 0)
6424    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6425                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6426                                   cacheMonomials, false);
6427  else
6428    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6429                              (noIdeal ? 0 : IasSB), false);
6430  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6431  return FALSE;
6432}
6433static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6434{
6435  // u: the name of the new type
6436  // v: the parent type
6437  // w: the elements
6438  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6439                                            (const char *)w->Data());
6440  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6441  return (d==NULL);
6442}
6443static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6444{
6445  // handles preimage(r,phi,i) and kernel(r,phi)
6446  idhdl h;
6447  ring rr;
6448  map mapping;
6449  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6450
6451  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6452  {
6453    WerrorS("2nd/3rd arguments must have names");
6454    return TRUE;
6455  }
6456  rr=(ring)u->Data();
6457  const char *ring_name=u->Name();
6458  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6459  {
6460    if (h->typ==MAP_CMD)
6461    {
6462      mapping=IDMAP(h);
6463      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6464      if ((preim_ring==NULL)
6465      || (IDRING(preim_ring)!=currRing))
6466      {
6467        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6468        return TRUE;
6469      }
6470    }
6471    else if (h->typ==IDEAL_CMD)
6472    {
6473      mapping=IDMAP(h);
6474    }
6475    else
6476    {
6477      Werror("`%s` is no map nor ideal",IDID(h));
6478      return TRUE;
6479    }
6480  }
6481  else
6482  {
6483    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6484    return TRUE;
6485  }
6486  ideal image;
6487  if (kernel_cmd) image=idInit(1,1);
6488  else
6489  {
6490    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6491    {
6492      if (h->typ==IDEAL_CMD)
6493      {
6494        image=IDIDEAL(h);
6495      }
6496      else
6497      {
6498        Werror("`%s` is no ideal",IDID(h));
6499        return TRUE;
6500      }
6501    }
6502    else
6503    {
6504      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6505      return TRUE;
6506    }
6507  }
6508  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering(currRing)))
6509  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6510  {
6511    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6512  }
6513  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6514  if (kernel_cmd) idDelete(&image);
6515  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6516}
6517static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6518{
6519  int di, k;
6520  int i=(int)(long)u->Data();
6521  int r=(int)(long)v->Data();
6522  int c=(int)(long)w->Data();
6523  if ((r<=0) || (c<=0)) return TRUE;
6524  intvec *iv = new intvec(r, c, 0);
6525  if (iv->rows()==0)
6526  {
6527    delete iv;
6528    return TRUE;
6529  }
6530  if (i!=0)
6531  {
6532    if (i<0) i = -i;
6533    di = 2 * i + 1;
6534    for (k=0; k<iv->length(); k++)
6535    {
6536      (*iv)[k] = ((siRand() % di) - i);
6537    }
6538  }
6539  res->data = (char *)iv;
6540  return FALSE;
6541}
6542#ifdef SINGULAR_4_2
6543static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6544// <coeff>, par1, par2 -> number2
6545{
6546  coeffs cf=(coeffs)u->Data();
6547  if ((cf==NULL) ||(cf->cfRandom==NULL))
6548  {
6549    Werror("no random function defined for coeff %d",cf->type);
6550    return TRUE;
6551  }
6552  else
6553  {
6554    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6555    number2 nn=(number2)omAlloc(sizeof(*nn));
6556    nn->cf=cf;
6557    nn->n=n;
6558    res->data=nn;
6559    return FALSE;
6560  }
6561  return TRUE;
6562}
6563#endif
6564static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6565  int &ringvar, poly &monomexpr)
6566{
6567  monomexpr=(poly)w->Data();
6568  poly p=(poly)v->Data();
6569#if 0
6570  if (pLength(monomexpr)>1)
6571  {
6572    Werror("`%s` substitutes a ringvar only by a term",
6573      Tok2Cmdname(SUBST_CMD));
6574    return TRUE;
6575  }
6576#endif
6577  if ((ringvar=pVar(p))==0)
6578  {
6579    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6580    {
6581      number n = pGetCoeff(p);
6582      ringvar= -n_IsParam(n, currRing);
6583    }
6584    if(ringvar==0)
6585    {
6586      WerrorS("ringvar/par expected");
6587      return TRUE;
6588    }
6589  }
6590  return FALSE;
6591}
6592static BOOLEAN jjSUBST_Bu(leftv res, leftv u, leftv v,leftv w)
6593{
6594  // generic conversion from polyBucket to poly:
6595  // force this to be the first try everytime
6596  poly p; int l;
6597  sBucket_pt bu=(sBucket_pt)w->CopyD();
6598  sBucketDestroyAdd(bu,&p,&l);
6599  sleftv tmpw;
6600  tmpw.Init();
6601  tmpw.rtyp=POLY_CMD;
6602  tmpw.data=p;
6603  return iiExprArith3(res, iiOp, u, v, &tmpw);
6604}
6605static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6606{
6607  int ringvar;
6608  poly monomexpr;
6609  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6610  if (nok) return TRUE;
6611  poly p=(poly)u->Data();
6612  if (ringvar>0)
6613  {
6614    int mm=p_MaxExpPerVar(p,ringvar,currRing);
6615    if ((monomexpr!=NULL) && (p!=NULL) && (mm!=0) &&
6616    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)mm/2)))
6617    {
6618      Warn("possible OVERFLOW in subst, max exponent is %ld, substituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), mm);
6619      //return TRUE;
6620    }
6621    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6622      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6623    else
6624      res->data= pSubstPoly(p,ringvar,monomexpr);
6625  }
6626  else
6627  {
6628    if (rIsLPRing(currRing))
6629    {
6630      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6631      return TRUE;
6632    }
6633    res->data=pSubstPar(p,-ringvar,monomexpr);
6634  }
6635  return FALSE;
6636}
6637static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6638{
6639  int ringvar;
6640  poly monomexpr;
6641  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6642  if (nok) return TRUE;
6643  ideal id=(ideal)u->Data();
6644  if (ringvar>0)
6645  {
6646    BOOLEAN overflow=FALSE;
6647    if (monomexpr!=NULL)
6648    {
6649      long deg_monexp=pTotaldegree(monomexpr);
6650      for(int i=IDELEMS(id)-1;i>=0;i--)
6651      {
6652        poly p=id->m[i];
6653        int mm=p_MaxExpPerVar(p,ringvar,currRing);
6654        if ((p!=NULL) && (mm!=0) &&
6655        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)mm/2)))
6656        {
6657          overflow=TRUE;
6658          break;
6659        }
6660      }
6661    }
6662    if (overflow)
6663      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6664    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6665    {
6666      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6667      else                       id=id_Copy(id,currRing);
6668      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6669    }
6670    else
6671      res->data = idSubstPoly(id,ringvar,monomexpr);
6672  }
6673  else
6674  {
6675    if (rIsLPRing(currRing))
6676    {
6677      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6678      return TRUE;
6679    }
6680    res->data = idSubstPar(id,-ringvar,monomexpr);
6681  }
6682  return FALSE;
6683}
6684// we do not want to have jjSUBST_Id_X inlined:
6685static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6686                            int input_type);
6687static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6688{
6689  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6690}
6691static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6692{
6693  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6694}
6695static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6696{
6697  sleftv tmp;
6698  tmp.Init();
6699  // do not check the result, conversion from int/number to poly works always
6700  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6701  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6702  tmp.CleanUp();
6703  return b;
6704}
6705static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6706{
6707  int mi=(int)(long)v->Data();
6708  int ni=(int)(long)w->Data();
6709  if ((mi<1)||(ni<1))
6710  {
6711    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6712    return TRUE;
6713  }
6714  matrix m=mpNew(mi,ni);
6715  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6716  int i=si_min(IDELEMS(I),mi*ni);
6717  //for(i=i-1;i>=0;i--)
6718  //{
6719  //  m->m[i]=I->m[i];
6720  //  I->m[i]=NULL;
6721  //}
6722  memcpy(m->m,I->m,i*sizeof(poly));
6723  memset(I->m,0,i*sizeof(poly));
6724  id_Delete(&I,currRing);
6725  res->data = (char *)m;
6726  return FALSE;
6727}
6728static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6729{
6730  int mi=(int)(long)v->Data();
6731  int ni=(int)(long)w->Data();
6732  if ((mi<0)||(ni<1))
6733  {
6734    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6735    return TRUE;
6736  }
6737  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6738           mi,ni,currRing);
6739  return FALSE;
6740}
6741static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6742{
6743  int mi=(int)(long)v->Data();
6744  int ni=(int)(long)w->Data();
6745  if ((mi<1)||(ni<1))
6746  {
6747     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6748    return TRUE;
6749  }
6750  matrix m=mpNew(mi,ni);
6751  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6752  int r=si_min(MATROWS(I),mi);
6753  int c=si_min(MATCOLS(I),ni);
6754  int i,j;
6755  for(i=r;i>0;i--)
6756  {
6757    for(j=c;j>0;j--)
6758    {
6759      MATELEM(m,i,j)=MATELEM(I,i,j);
6760      MATELEM(I,i,j)=NULL;
6761    }
6762  }
6763  id_Delete((ideal *)&I,currRing);
6764  res->data = (char *)m;
6765  return FALSE;
6766}
6767static BOOLEAN jjMODULO3(leftv res, leftv u, leftv v, leftv w)
6768{
6769  if (w->rtyp!=IDHDL) return TRUE; /* idhdhl required */
6770  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6771  tHomog hom=testHomog;
6772  if (w_u!=NULL)
6773  {
6774    w_u=ivCopy(w_u);
6775    hom=isHomog;
6776  }
6777  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
6778  if (w_v!=NULL)
6779  {
6780    w_v=ivCopy(w_v);
6781    hom=isHomog;
6782  }
6783  if ((w_u!=NULL) && (w_v==NULL))
6784    w_v=ivCopy(w_u);
6785  if ((w_v!=NULL) && (w_u==NULL))
6786    w_u=ivCopy(w_v);
6787  ideal u_id=(ideal)u->Data();
6788  ideal v_id=(ideal)v->Data();
6789  if (w_u!=NULL)
6790  {
6791     if ((*w_u).compare((w_v))!=0)
6792     {
6793       WarnS("incompatible weights");
6794       delete w_u; w_u=NULL;
6795       hom=testHomog;
6796     }
6797     else
6798     {
6799       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
6800       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
6801       {
6802         WarnS("wrong weights");
6803         delete w_u; w_u=NULL;
6804         hom=testHomog;
6805       }
6806     }
6807  }
6808  idhdl h=(idhdl)w->data;
6809  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u, &(h->data.umatrix));
6810  if (w_u!=NULL)
6811  {
6812    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
6813  }
6814  delete w_v;
6815  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6816  return FALSE;
6817}
6818static BOOLEAN jjMODULO3S(leftv res, leftv u, leftv v, leftv w)
6819{
6820  if (w->rtyp!=IDHDL) return TRUE; /* idhdhl required */
6821  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6822  tHomog hom=testHomog;
6823  if (w_u!=NULL)
6824  {
6825    w_u=ivCopy(w_u);
6826    hom=isHomog;
6827  }
6828  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
6829  if (w_v!=NULL)
6830  {
6831    w_v=ivCopy(w_v);
6832    hom=isHomog;
6833  }
6834  if ((w_u!=NULL) && (w_v==NULL))
6835    w_v=ivCopy(w_u);
6836  if ((w_v!=NULL) && (w_u==NULL))
6837    w_u=ivCopy(w_v);
6838  ideal u_id=(ideal)u->Data();
6839  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,u_id);
6840  ideal v_id=(ideal)v->Data();
6841  if (w_u!=NULL)
6842  {
6843     if ((*w_u).compare((w_v))!=0)
6844     {
6845       WarnS("incompatible weights");
6846       delete w_u; w_u=NULL;
6847       hom=testHomog;
6848     }
6849     else
6850     {
6851       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
6852       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
6853       {
6854         WarnS("wrong weights");
6855         delete w_u; w_u=NULL;
6856         hom=testHomog;
6857       }
6858     }
6859  }
6860  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u, NULL,alg);
6861  if (w_u!=NULL)
6862  {
6863    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
6864  }
6865  delete w_v;
6866  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6867  return FALSE;
6868}
6869static BOOLEAN jjSMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6870{
6871  int mi=(int)(long)v->Data();
6872  int ni=(int)(long)w->Data();
6873  if ((mi<0)||(ni<1))
6874  {
6875    Werror("converting to smatrix: dimensions must be positive(%dx%d)",mi,ni);
6876    return TRUE;
6877  }
6878  res->data = (char *)id_ResizeModule((ideal)u->CopyD(),
6879           mi,ni,currRing);
6880  return FALSE;
6881}
6882static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6883{
6884  if (w->rtyp!=IDHDL) return TRUE;
6885  int ul= IDELEMS((ideal)u->Data());
6886  int vl= IDELEMS((ideal)v->Data());
6887#ifdef HAVE_SHIFTBBA
6888  if (rIsLPRing(currRing))
6889  {
6890    if (currRing->LPncGenCount < ul)
6891    {
6892      Werror("At least %d ncgen variables are needed for this computation.", ul);
6893      return TRUE;
6894    }
6895  }
6896#endif
6897  ideal m
6898    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6899             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6900  if (m==NULL) return TRUE;
6901  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6902  return FALSE;
6903}
6904static BOOLEAN jjLIFTSTD_SYZ(leftv res, leftv u, leftv v, leftv w)
6905{
6906  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6907  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6908  idhdl hv=(idhdl)v->data;
6909  idhdl hw=(idhdl)w->data;
6910#ifdef HAVE_SHIFTBBA
6911  if (rIsLPRing(currRing))
6912  {
6913    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
6914    {
6915      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
6916      return TRUE;
6917    }
6918  }
6919#endif
6920  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6921  res->data = (char *)idLiftStd((ideal)u->Data(),
6922                                &(hv->data.umatrix),testHomog,
6923                                &(hw->data.uideal));
6924  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6925  return FALSE;
6926}
6927static BOOLEAN jjLIFTSTD_ALG(leftv res, leftv u, leftv v, leftv w)
6928{
6929  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6930  idhdl hv=(idhdl)v->data;
6931  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,(ideal)u->Data());
6932#ifdef HAVE_SHIFTBBA
6933  if (rIsLPRing(currRing))
6934  {
6935    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
6936    {
6937      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
6938      return TRUE;
6939    }
6940  }
6941#endif
6942  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6943  res->data = (char *)idLiftStd((ideal)u->Data(),
6944                                &(hv->data.umatrix),testHomog,
6945                                NULL,alg);
6946  setFlag(res,FLAG_STD); v->flag=0;
6947  return FALSE;
6948}
6949static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6950{
6951  assumeStdFlag(v);
6952  if (!idIsZeroDim((ideal)v->Data()))
6953  {
6954    Werror("`%s` must be 0-dimensional",v->Name());
6955    return TRUE;
6956  }
6957  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6958    (poly)w->CopyD());
6959  return FALSE;
6960}
6961static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6962{
6963  assumeStdFlag(v);
6964  if (!idIsZeroDim((ideal)v->Data()))
6965  {
6966    Werror("`%s` must be 0-dimensional",v->Name());
6967    return TRUE;
6968  }
6969  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6970    (matrix)w->CopyD());
6971  return FALSE;
6972}
6973static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6974{
6975  assumeStdFlag(v);
6976  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6977    0,(int)(long)w->Data());
6978  return FALSE;
6979}
6980static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6981{
6982  assumeStdFlag(v);
6983  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6984    0,(int)(long)w->Data());
6985  return FALSE;
6986}
6987#ifdef OLD_RES
6988static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6989{
6990  int maxl=(int)v->Data();
6991  ideal u_id=(ideal)u->Data();
6992  int l=0;
6993  resolvente r;
6994  intvec **weights=NULL;
6995  int wmaxl=maxl;
6996  maxl--;
6997  unsigned save_opt=si_opt_1;
6998  si_opt_1 |= Sy_bit(OPT_REDTAIL_SYZ);
6999  if ((maxl==-1) && (iiOp!=MRES_CMD))
7000    maxl = currRing->N-1;
7001  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
7002  {
7003    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
7004    if (iv!=NULL)
7005    {
7006      l=1;
7007      if (!idTestHomModule(u_id,currRing->qideal,iv))
7008      {
7009        WarnS("wrong weights");
7010        iv=NULL;
7011      }
7012      else
7013      {
7014        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
7015        weights[0] = ivCopy(iv);
7016      }
7017    }
7018    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
7019  }
7020  else
7021    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
7022  if (r==NULL) return TRUE;
7023  int t3=u->Typ();
7024  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
7025  si_opt_1=save_opt;
7026  return FALSE;
7027}
7028#endif
7029static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
7030{
7031  res->data=(void *)rInit(u,v,w);
7032  return (res->data==NULL);
7033}
7034static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
7035{
7036  int yes;
7037  jjSTATUS2(res, u, v);
7038  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
7039  omFree((ADDRESS) res->data);
7040  res->data = (void *)(long)yes;
7041  return FALSE;
7042}
7043static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
7044{
7045  intvec *vw=(intvec *)w->Data(); // weights of vars
7046  if (vw->length()!=currRing->N)
7047  {
7048    Werror("%d weights for %d variables",vw->length(),currRing->N);
7049    return TRUE;
7050  }
7051  ideal result;
7052  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7053  tHomog hom=testHomog;
7054  ideal u_id=(ideal)(u->Data());
7055  if (ww!=NULL)
7056  {
7057    if (!idTestHomModule(u_id,currRing->qideal,ww))
7058    {
7059      WarnS("wrong weights");
7060      ww=NULL;
7061    }
7062    else
7063    {
7064      ww=ivCopy(ww);
7065      hom=isHomog;
7066    }
7067  }
7068  result=kStd(u_id,
7069              currRing->qideal,
7070              hom,
7071              &ww,                  // module weights
7072              (intvec *)v->Data(),  // hilbert series
7073              0,0,                  // syzComp, newIdeal
7074              vw);                  // weights of vars
7075  idSkipZeroes(result);
7076  res->data = (char *)result;
7077  setFlag(res,FLAG_STD);
7078  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7079  return FALSE;
7080}
7081
7082/*=================== operations with many arg.: static proc =================*/
7083/* must be ordered: first operations for chars (infix ops),
7084 * then alphabetically */
7085static BOOLEAN jjBREAK0(leftv, leftv)
7086{
7087#ifdef HAVE_SDB
7088  sdb_show_bp();
7089#endif
7090  return FALSE;
7091}
7092static BOOLEAN jjBREAK1(leftv, leftv v)
7093{
7094#ifdef HAVE_SDB
7095  if(v->Typ()==PROC_CMD)
7096  {
7097    int lineno=0;
7098    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
7099    {
7100      lineno=(int)(long)v->next->Data();
7101    }
7102    return sdb_set_breakpoint(v->Name(),lineno);
7103  }
7104  return TRUE;
7105#else
7106 return FALSE;
7107#endif
7108}
7109static BOOLEAN jjCALL1ARG(leftv res, leftv v)
7110{
7111  return iiExprArith1(res,v,iiOp);
7112}
7113static BOOLEAN jjCALL2ARG(leftv res, leftv u)
7114{
7115  leftv v=u->next;
7116  u->next=NULL;
7117  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
7118  u->next=v;
7119  return b;
7120}
7121static BOOLEAN jjCALL3ARG(leftv res, leftv u)
7122{
7123  leftv v = u->next;
7124  leftv w = v->next;
7125  u->next = NULL;
7126  v->next = NULL;
7127  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7128  u->next = v;
7129  v->next = w;
7130  return b;
7131}
7132
7133static BOOLEAN jjCOEF_M(leftv, leftv v)
7134{
7135  const short t[]={4,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD};
7136  if (iiCheckTypes(v,t,1))
7137  {
7138    idhdl c=(idhdl)v->next->next->data;
7139    if (v->next->next->next->rtyp!=IDHDL) return TRUE;
7140    idhdl m=(idhdl)v->next->next->next->data;
7141    idDelete((ideal *)&(c->data.uideal));
7142    idDelete((ideal *)&(m->data.uideal));
7143    mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
7144      (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
7145    return FALSE;
7146  }
7147  return TRUE;
7148}
7149
7150static BOOLEAN jjDIVISION4(leftv res, leftv v)
7151{ // may have 3 or 4 arguments
7152  leftv v1=v;
7153  leftv v2=v1->next;
7154  leftv v3=v2->next;
7155  leftv v4=v3->next;
7156  assumeStdFlag(v2);
7157
7158  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
7159  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
7160
7161  if((i1==0)||(i2==0)
7162  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
7163  {
7164    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
7165    return TRUE;
7166  }
7167
7168  sleftv w1,w2;
7169  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
7170  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
7171  ideal P=(ideal)w1.Data();
7172  ideal Q=(ideal)w2.Data();
7173
7174  int n=(int)(long)v3->Data();
7175  int *w=NULL;
7176  if(v4!=NULL)
7177  {
7178    w = iv2array((intvec *)v4->Data(),currRing);
7179    int * w0 = w + 1;
7180    int i = currRing->N;
7181    while( (i > 0) && ((*w0) > 0) )
7182    {
7183      w0++;
7184      i--;
7185    }
7186    if(i>0)
7187      WarnS("not all weights are positive!");
7188  }
7189
7190  matrix T;
7191  ideal R;
7192  idLiftW(P,Q,n,T,R,w);
7193
7194  w1.CleanUp();
7195  w2.CleanUp();
7196  if(w!=NULL)
7197    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(int) );
7198
7199  lists L=(lists) omAllocBin(slists_bin);
7200  L->Init(2);
7201  L->m[1].rtyp=v1->Typ();
7202  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
7203  {
7204    if(v1->Typ()==POLY_CMD)
7205      p_Shift(&R->m[0],-1,currRing);
7206    L->m[1].data=(void *)R->m[0];
7207    R->m[0]=NULL;
7208    idDelete(&R);
7209  }
7210  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
7211    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
7212  else
7213  {
7214    L->m[1].rtyp=MODUL_CMD;
7215    L->m[1].data=(void *)R;
7216  }
7217  L->m[0].rtyp=MATRIX_CMD;
7218  L->m[0].data=(char *)T;
7219
7220  res->data=L;
7221
7222  return FALSE;
7223}
7224
7225//BOOLEAN jjDISPATCH(leftv res, leftv v)
7226//{
7227//  WerrorS("`dispatch`: not implemented");
7228//  return TRUE;
7229//}
7230
7231//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
7232//{
7233//  int l=u->listLength();
7234//  if (l<2) return TRUE;
7235//  BOOLEAN b;
7236//  leftv v=u->next;
7237//  leftv zz=v;
7238//  leftv z=zz;
7239//  u->next=NULL;
7240//  do
7241//  {
7242//    leftv z=z->next;
7243//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
7244//    if (b) break;
7245//  } while (z!=NULL);
7246//  u->next=zz;
7247//  return b;
7248//}
7249static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
7250{
7251  int s=1;
7252  leftv h=v;
7253  if (h!=NULL) s=exprlist_length(h);
7254  ideal id=idInit(s,1);
7255  int rank=1;
7256  int i=0;
7257  poly p;
7258  int dest_type=POLY_CMD;
7259  if (iiOp==MODUL_CMD) dest_type=VECTOR_CMD;
7260  while (h!=NULL)
7261  {
7262    // use standard type conversions to poly/vector
7263    int ri;
7264    int ht=h->Typ();
7265    if (ht==dest_type)
7266    {
7267      p=(poly)h->CopyD();
7268      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7269    }
7270    else if ((ri=iiTestConvert(ht,dest_type,dConvertTypes))!=0)
7271    {
7272      sleftv tmp;
7273      leftv hnext=h->next;
7274      h->next=NULL;
7275      iiConvert(ht,dest_type,ri,h,&tmp,dConvertTypes);
7276      h->next=hnext;
7277      p=(poly)tmp.data;
7278      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7279    }
7280    else
7281    {
7282      idDelete(&id);
7283      return TRUE;
7284    }
7285    id->m[i]=p;
7286    i++;
7287    h=h->next;
7288  }
7289  id->rank=rank;
7290  res->data=(char *)id;
7291  return FALSE;
7292}
7293static BOOLEAN jjFETCH_M(leftv res, leftv u)
7294{
7295  ring r=(ring)u->Data();
7296  leftv v=u->next;
7297  leftv perm_var_l=v->next;
7298  leftv perm_par_l=v->next->next;
7299  if ((perm_var_l->Typ()!=INTVEC_CMD)
7300  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
7301  ||(u->Typ()!=RING_CMD))
7302  {
7303    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
7304    return TRUE;
7305  }
7306  intvec *perm_var_v=(intvec*)perm_var_l->Data();
7307  intvec *perm_par_v=NULL;
7308  if (perm_par_l!=NULL)
7309    perm_par_v=(intvec*)perm_par_l->Data();
7310  idhdl w;
7311  nMapFunc nMap;
7312
7313  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
7314  {
7315    int *perm=NULL;
7316    int *par_perm=NULL;
7317    int par_perm_size=0;
7318    BOOLEAN bo;
7319    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
7320    {
7321      // Allow imap/fetch to be make an exception only for:
7322      if (nCoeff_is_Extension(r->cf) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
7323         ((n_SetMap(r->cf->extRing->cf,currRing->cf)!=NULL)
7324         || (nCoeff_is_Extension(currRing->cf) && (n_SetMap(r->cf->extRing->cf,currRing->cf->extRing->cf)!=NULL))))
7325      {
7326        par_perm_size=rPar(r);
7327      }
7328      else
7329      {
7330        goto err_fetch;
7331      }
7332    }
7333    else
7334      par_perm_size=rPar(r);
7335    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
7336    if (par_perm_size!=0)
7337      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
7338    int i;
7339    if (perm_par_l==NULL)
7340    {
7341      if (par_perm_size!=0)
7342        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
7343    }
7344    else
7345    {
7346      if (par_perm_size==0) WarnS("source ring has no parameters");
7347      else
7348      {
7349        for(i=rPar(r)-1;i>=0;i--)
7350        {
7351          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
7352          if ((par_perm[i]<-rPar(currRing))
7353          || (par_perm[i]>rVar(currRing)))
7354          {
7355            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
7356            par_perm[i]=0;
7357          }
7358        }
7359      }
7360    }
7361    for(i=rVar(r)-1;i>=0;i--)
7362    {
7363      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
7364      if ((perm[i]<-rPar(currRing))
7365      || (perm[i]>rVar(currRing)))
7366      {
7367        Warn("invalid entry for var %d: %d\n",i,perm[i]);
7368        perm[i]=0;
7369      }
7370    }
7371    if (BVERBOSE(V_IMAP))
7372    {
7373      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
7374      {
7375        if (perm[i]>0)
7376          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
7377        else if (perm[i]<0)
7378          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
7379      }
7380      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
7381      {
7382        if (par_perm[i-1]<0)
7383          Print("// par nr %d: %s -> par %s\n",
7384              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
7385        else if (par_perm[i-1]>0)
7386          Print("// par nr %d: %s -> var %s\n",
7387              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7388      }
7389    }
7390    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7391    sleftv tmpW;
7392    tmpW.Init();
7393    tmpW.rtyp=IDTYP(w);
7394    tmpW.data=IDDATA(w);
7395    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7396                         perm,par_perm,par_perm_size,nMap)))
7397    {
7398      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7399    }
7400    if (perm!=NULL)
7401      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7402    if (par_perm!=NULL)
7403      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7404    return bo;
7405  }
7406  else
7407  {
7408    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7409  }
7410  return TRUE;
7411err_fetch:
7412  char *s1=nCoeffString(r->cf);
7413  char *s2=nCoeffString(currRing->cf);
7414  Werror("no identity map from %s (%s -> %s)",u->Fullname(),s1,s2);
7415  omFree(s2);omFree(s1);
7416  return TRUE;
7417}
7418static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7419{
7420  leftv h=v;
7421  int l=v->listLength();
7422  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7423  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7424  int t=0;
7425  // try to convert to IDEAL_CMD
7426  while (h!=NULL)
7427  {
7428    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7429    {
7430      t=IDEAL_CMD;
7431    }
7432    else break;
7433    h=h->next;
7434  }
7435  // if failure, try MODUL_CMD
7436  if (t==0)
7437  {
7438    h=v;
7439    while (h!=NULL)
7440    {
7441      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7442      {
7443        t=MODUL_CMD;
7444      }
7445      else break;
7446      h=h->next;
7447    }
7448  }
7449  // check for success  in converting
7450  if (t==0)
7451  {
7452    WerrorS("cannot convert to ideal or module");
7453    return TRUE;
7454  }
7455  // call idMultSect
7456  h=v;
7457  int i=0;
7458  sleftv tmp;
7459  while (h!=NULL)
7460  {
7461    if (h->Typ()==t)
7462    {
7463      r[i]=(ideal)h->Data(); /*no copy*/
7464      h=h->next;
7465    }
7466    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7467    {
7468      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7469      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7470      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7471      return TRUE;
7472    }
7473    else
7474    {
7475      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7476      copied[i]=TRUE;
7477      h=tmp.next;
7478    }
7479    i++;
7480  }
7481  res->rtyp=t;
7482  res->data=(char *)idMultSect(r,i);
7483  while(i>0)
7484  {
7485    i--;
7486    if (copied[i]) idDelete(&(r[i]));
7487  }
7488  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7489  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7490  return FALSE;
7491}
7492static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7493{
7494  /* computation of the inverse of a quadratic matrix A
7495     using the L-U-decomposition of A;
7496     There are two valid parametrisations:
7497     1) exactly one argument which is just the matrix A,
7498     2) exactly three arguments P, L, U which already
7499        realise the L-U-decomposition of A, that is,
7500        P * A = L * U, and P, L, and U satisfy the
7501        properties decribed in method 'jjLU_DECOMP';
7502        see there;
7503     If A is invertible, the list [1, A^(-1)] is returned,
7504     otherwise the list [0] is returned. Thus, the user may
7505     inspect the first entry of the returned list to see
7506     whether A is invertible. */
7507  matrix iMat; int invertible;
7508  const short t1[]={1,MATRIX_CMD};
7509  const short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7510  if (iiCheckTypes(v,t1))
7511  {
7512    matrix aMat = (matrix)v->Data();
7513    int rr = aMat->rows();
7514    int cc = aMat->cols();
7515    if (rr != cc)
7516    {
7517      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7518      return TRUE;
7519    }
7520    if (!idIsConstant((ideal)aMat))
7521    {
7522      WerrorS("matrix must be constant");
7523      return TRUE;
7524    }
7525    invertible = luInverse(aMat, iMat);
7526  }
7527  else if (iiCheckTypes(v,t2))
7528  {
7529     matrix pMat = (matrix)v->Data();
7530     matrix lMat = (matrix)v->next->Data();
7531     matrix uMat = (matrix)v->next->next->Data();
7532     int rr = uMat->rows();
7533     int cc = uMat->cols();
7534     if (rr != cc)
7535     {
7536       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7537              rr, cc);
7538       return TRUE;
7539     }
7540      if (!idIsConstant((ideal)pMat)
7541      || (!idIsConstant((ideal)lMat))
7542      || (!idIsConstant((ideal)uMat))
7543      )
7544      {
7545        WerrorS("matricesx must be constant");
7546        return TRUE;
7547      }
7548     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7549  }
7550  else
7551  {
7552    Werror("expected either one or three matrices");
7553    return TRUE;
7554  }
7555
7556  /* build the return structure; a list with either one or two entries */
7557  lists ll = (lists)omAllocBin(slists_bin);
7558  if (invertible)
7559  {
7560    ll->Init(2);
7561    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7562    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7563  }
7564  else
7565  {
7566    ll->Init(1);
7567    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7568  }
7569
7570  res->data=(char*)ll;
7571  return FALSE;
7572}
7573static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7574{
7575  /* for solving a linear equation system A * x = b, via the
7576     given LU-decomposition of the matrix A;
7577     There is one valid parametrisation:
7578     1) exactly four arguments P, L, U, b;
7579        P, L, and U realise the L-U-decomposition of A, that is,
7580        P * A = L * U, and P, L, and U satisfy the
7581        properties decribed in method 'jjLU_DECOMP';
7582        see there;
7583        b is the right-hand side vector of the equation system;
7584     The method will return a list of either 1 entry or three entries:
7585     1) [0] if there is no solution to the system;
7586     2) [1, x, H] if there is at least one solution;
7587        x is any solution of the given linear system,
7588        H is the matrix with column vectors spanning the homogeneous
7589        solution space.
7590     The method produces an error if matrix and vector sizes do not fit. */
7591  const short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7592  if (!iiCheckTypes(v,t))
7593  {
7594    WerrorS("expected exactly three matrices and one vector as input");
7595    return TRUE;
7596  }
7597  matrix pMat = (matrix)v->Data();
7598  matrix lMat = (matrix)v->next->Data();
7599  matrix uMat = (matrix)v->next->next->Data();
7600  matrix bVec = (matrix)v->next->next->next->Data();
7601  matrix xVec; int solvable; matrix homogSolSpace;
7602  if (pMat->rows() != pMat->cols())
7603  {
7604    Werror("first matrix (%d x %d) is not quadratic",
7605           pMat->rows(), pMat->cols());
7606    return TRUE;
7607  }
7608  if (lMat->rows() != lMat->cols())
7609  {
7610    Werror("second matrix (%d x %d) is not quadratic",
7611           lMat->rows(), lMat->cols());
7612    return TRUE;
7613  }
7614  if (lMat->rows() != uMat->rows())
7615  {
7616    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7617           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7618    return TRUE;
7619  }
7620  if (uMat->rows() != bVec->rows())
7621  {
7622    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7623           uMat->rows(), uMat->cols(), bVec->rows());
7624    return TRUE;
7625  }
7626  if (!idIsConstant((ideal)pMat)
7627  ||(!idIsConstant((ideal)lMat))
7628  ||(!idIsConstant((ideal)uMat))
7629  )
7630  {
7631    WerrorS("matrices must be constant");
7632    return TRUE;
7633  }
7634  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7635
7636  /* build the return structure; a list with either one or three entries */
7637  lists ll = (lists)omAllocBin(slists_bin);
7638  if (solvable)
7639  {
7640    ll->Init(3);
7641    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7642    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7643    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7644  }
7645  else
7646  {
7647    ll->Init(1);
7648    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7649  }
7650
7651  res->data=(char*)ll;
7652  return FALSE;
7653}
7654static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7655{
7656  int i=0;
7657  leftv h=v;
7658  if (h!=NULL) i=exprlist_length(h);
7659  intvec *iv=new intvec(i);
7660  i=0;
7661  while (h!=NULL)
7662  {
7663    if(h->Typ()==INT_CMD)
7664    {
7665      (*iv)[i]=(int)(long)h->Data();
7666    }
7667    else if (h->Typ()==INTVEC_CMD)
7668    {
7669      intvec *ivv=(intvec*)h->Data();
7670      for(int j=0;j<ivv->length();j++,i++)
7671      {
7672        (*iv)[i]=(*ivv)[j];
7673      }
7674      i--;
7675    }
7676    else
7677    {
7678      delete iv;
7679      return TRUE;
7680    }
7681    i++;
7682    h=h->next;
7683  }
7684  res->data=(char *)iv;
7685  return FALSE;
7686}
7687static BOOLEAN jjJET4(leftv res, leftv u)
7688{
7689  const short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7690  const short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7691  const short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7692  const short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7693  leftv u1=u;
7694  leftv u2=u1->next;
7695  leftv u3=u2->next;
7696  leftv u4=u3->next;
7697  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7698  {
7699    if(!pIsUnit((poly)u2->Data()))
7700    {
7701      WerrorS("2nd argument must be a unit");
7702      return TRUE;
7703    }
7704    res->rtyp=u1->Typ();
7705    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7706                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7707    return FALSE;
7708  }
7709  else
7710  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7711  {
7712    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7713    {
7714      WerrorS("2nd argument must be a diagonal matrix of units");
7715      return TRUE;
7716    }
7717    res->rtyp=u1->Typ();
7718    res->data=(char*)idSeries(
7719                              (int)(long)u3->Data(),
7720                              idCopy((ideal)u1->Data()),
7721                              mp_Copy((matrix)u2->Data(), currRing),
7722                              (intvec*)u4->Data()
7723                             );
7724    return FALSE;
7725  }
7726  else
7727  {
7728    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7729           Tok2Cmdname(iiOp));
7730    return TRUE;
7731  }
7732}
7733#if 0
7734static BOOLEAN jjBRACKET_PL(leftv res, leftv u)
7735{
7736  int ut=u->Typ();
7737  leftv v=u->next; u->next=NULL;
7738  leftv w=v->next; v->next=NULL;
7739  if ((ut!=CRING_CMD)&&(ut!=RING_CMD))
7740  {
7741    BOOLEAN bo=TRUE;
7742    if (w==NULL)
7743    {
7744      bo=iiExprArith2(res,u,'[',v);
7745    }
7746    else if (w->next==NULL)
7747    {
7748      bo=iiExprArith3(res,'[',u,v,w);
7749    }
7750    v->next=w;
7751    u->next=v;
7752    return bo;
7753  }
7754  v->next=w;
7755  u->next=v;
7756  #ifdef SINGULAR_4_1
7757  // construct new rings:
7758  while (u!=NULL)
7759  {
7760    Print("name: %s,\n",u->Name());
7761    u=u->next;
7762  }
7763  #else
7764  res->Init();
7765  res->rtyp=NONE;
7766  return TRUE;
7767  #endif
7768}
7769#endif
7770static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7771{
7772  if ((yyInRingConstruction)
7773  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7774  {
7775    memcpy(res,u,sizeof(sleftv));
7776    u->Init();
7777    return FALSE;
7778  }
7779  leftv v=u->next;
7780  BOOLEAN b;
7781  if(v==NULL)  // p()
7782    b=iiExprArith1(res,u,iiOp);
7783  else if ((v->next==NULL) // p(1)
7784  || (u->Typ()!=UNKNOWN))  // p(1,2), p proc or map
7785  {
7786    u->next=NULL;
7787    b=iiExprArith2(res,u,iiOp,v);
7788    u->next=v;
7789  }
7790  else // p(1,2), p undefined
7791  {
7792    if (v->Typ()!=INT_CMD)
7793    {
7794      Werror("`int` expected while building `%s(`",u->name);
7795      return TRUE;
7796    }
7797    int l=u->listLength();
7798    char * nn = (char *)omAlloc(strlen(u->name) + 12*l);
7799    sprintf(nn,"%s(%d",u->name,(int)(long)v->Data());
7800    char *s=nn;
7801    do
7802    {
7803      while (*s!='\0') s++;
7804      v=v->next;
7805      if (v->Typ()!=INT_CMD)
7806      {
7807        Werror("`int` expected while building `%s`",nn);
7808        omFree((ADDRESS)nn);
7809        return TRUE;
7810      }
7811      sprintf(s,",%d",(int)(long)v->Data());
7812    } while (v->next!=NULL);
7813    while (*s!='\0') s++;
7814    nn=strcat(nn,")");
7815    char *n=omStrDup(nn);
7816    omFree((ADDRESS)nn);
7817    syMake(res,n);
7818    b=FALSE;
7819  }
7820  return b;
7821}
7822static BOOLEAN jjLIFT_4(leftv res, leftv U)
7823{
7824  const short t1[]={4,IDEAL_CMD,IDEAL_CMD,MATRIX_CMD,STRING_CMD};
7825  const short t2[]={4,MODUL_CMD,MODUL_CMD,MATRIX_CMD,STRING_CMD};
7826  leftv u=U;
7827  leftv v=u->next;
7828  leftv w=v->next;
7829  leftv u4=w->next;
7830  if (w->rtyp!=IDHDL) return TRUE;
7831  if (iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7832  {
7833    // see jjLIFT3
7834    ideal I=(ideal)u->Data();
7835    int ul= IDELEMS(I /*(ideal)u->Data()*/);
7836    int vl= IDELEMS((ideal)v->Data());
7837    GbVariant alg=syGetAlgorithm((char*)u4->Data(),currRing,I);
7838    ideal m
7839    = idLift(I,(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
7840             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))),alg);
7841    if (m==NULL) return TRUE;
7842    res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
7843    return FALSE;
7844  }
7845  else
7846  {
7847    Werror("%s(`ideal`,`ideal`,`matrix`,`string`)\n"
7848           "or (`module`,`module`,`matrix`,`string`) expected",
7849           Tok2Cmdname(iiOp));
7850    return TRUE;
7851  }
7852}
7853static BOOLEAN jjLIFTSTD_M(leftv res, leftv U)
7854{
7855  // we have 4 or 5 arguments
7856  leftv u=U;
7857  leftv v=u->next;
7858  leftv u3=v->next;
7859  leftv u4=u3->next;
7860  leftv u5=u4->next; // might be NULL
7861
7862  ideal *syz=NULL;
7863  GbVariant alg=GbDefault;
7864  ideal h11=NULL;
7865
7866  if(u5==NULL)
7867  {
7868    // test all three possibilities for 4 arguments
7869    const short t1[]={4,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7870    const short t2[]={4,MODUL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7871    const short t3[]={4,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,IDEAL_CMD};
7872    const short t4[]={4,MODUL_CMD,MATRIX_CMD,MODUL_CMD,MODUL_CMD};
7873    const short t5[]={4,IDEAL_CMD,MATRIX_CMD,STRING_CMD,IDEAL_CMD};
7874    const short t6[]={4,MODUL_CMD,MATRIX_CMD,STRING_CMD,MODUL_CMD};
7875
7876    if(iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7877    {
7878      if ((u3->rtyp!=IDHDL)||(u3->e!=NULL)) return TRUE;
7879      idhdl hw=(idhdl)u3->data;
7880      syz=&(hw->data.uideal);
7881      alg=syGetAlgorithm((char*)u4->Data(),currRing,(ideal)u->Data());
7882    }
7883    else if(iiCheckTypes(U,t3)||iiCheckTypes(U,t4))
7884    {
7885      if ((u3->rtyp!=IDHDL)||(u3->e!=NULL)) return TRUE;
7886      idhdl hw=(idhdl)u3->data;
7887      syz=&(hw->data.uideal);
7888      h11=(ideal)u4->Data();
7889    }
7890    else if(iiCheckTypes(U,t5)||iiCheckTypes(U,t6))
7891    {
7892      alg=syGetAlgorithm((char*)u3->Data(),currRing,(ideal)u->Data());
7893      h11=(ideal)u4->Data();
7894    }
7895    else
7896    {
7897      Werror("%s(`ideal/module`,`matrix`[,`module`][,`string`][,`ideal/module`]) expected",Tok2Cmdname(iiOp));
7898      return TRUE;
7899    }
7900  }
7901  else
7902  {
7903    // we have 5 arguments
7904    const short t1[]={5,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD,IDEAL_CMD};
7905    const short t2[]={5,MODUL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD,MODUL_CMD};
7906    if(iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7907    {
7908      idhdl hw=(idhdl)u3->data;
7909      syz=&(hw->data.uideal);
7910      alg=syGetAlgorithm((char*)u4->Data(),currRing,(ideal)u->Data());
7911      h11=(ideal)u5->Data();
7912    }
7913    else
7914    {
7915      Werror("%s(`ideal/module`,`matrix`[,`module`][,`string`][,`ideal/module`]) expected",Tok2Cmdname(iiOp));
7916      return TRUE;
7917    }
7918  }
7919
7920#ifdef HAVE_SHIFTBBA
7921  if (rIsLPRing(currRing))
7922  {
7923    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
7924    {
7925      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
7926      return TRUE;
7927    }
7928  }
7929#endif
7930
7931  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
7932  idhdl hv=(idhdl)v->data;
7933  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
7934  res->rtyp = u->Typ();
7935  res->data = (char *)idLiftStd((ideal)u->Data(),
7936                              &(hv->data.umatrix),testHomog,
7937                              syz,alg,h11);
7938  setFlag(res,FLAG_STD); v->flag=0;
7939  if(syz!=NULL)
7940    u3->flag=0;
7941  return FALSE;
7942}
7943BOOLEAN jjLIST_PL(leftv res, leftv v)
7944{
7945  int sl=0;
7946  if (v!=NULL) sl = v->listLength();
7947  lists L;
7948  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7949  {
7950    int add_row_shift = 0;
7951    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7952    if (weights!=NULL)  add_row_shift=weights->min_in();
7953    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7954  }
7955  else
7956  {
7957    L=(lists)omAllocBin(slists_bin);
7958    leftv h=NULL;
7959    int i;
7960    int rt;
7961
7962    L->Init(sl);
7963    for (i=0;i<sl;i++)
7964    {
7965      if (h!=NULL)
7966      { /* e.g. not in the first step:
7967         * h is the pointer to the old sleftv,
7968         * v is the pointer to the next sleftv
7969         * (in this moment) */
7970         h->next=v;
7971      }
7972      h=v;
7973      v=v->next;
7974      h->next=NULL;
7975      rt=h->Typ();
7976      if (rt==0)
7977      {
7978        L->Clean();
7979        Werror("`%s` is undefined",h->Fullname());
7980        return TRUE;
7981      }
7982      if (rt==RING_CMD)
7983      {
7984        L->m[i].rtyp=rt;
7985        L->m[i].data=rIncRefCnt(((ring)h->Data()));
7986      }
7987      else
7988        L->m[i].Copy(h);
7989    }
7990  }
7991  res->data=(char *)L;
7992  return FALSE;
7993}
7994static BOOLEAN jjMODULO4(leftv res, leftv u)
7995{
7996  leftv v=u->next;
7997  leftv w=v->next;
7998  leftv u4=w->next;
7999  GbVariant alg;
8000  ideal u_id,v_id;
8001  // we have 4 arguments
8002  const short t1[]={4,IDEAL_CMD,IDEAL_CMD,MATRIX_CMD,STRING_CMD};
8003  const short t2[]={4,MODUL_CMD,MODUL_CMD,MATRIX_CMD,STRING_CMD};
8004  if(iiCheckTypes(u,t1)||iiCheckTypes(u,t2)||(w->rtyp!=IDHDL))
8005  {
8006    u_id=(ideal)u->Data();
8007    v_id=(ideal)v->Data();
8008    alg=syGetAlgorithm((char*)u4->Data(),currRing,u_id);
8009  }
8010  else
8011  {
8012    Werror("%s(`ideal/module`,`ideal/module`[,`matrix`][,`string`]) expected",Tok2Cmdname(iiOp));
8013    return TRUE;
8014  }
8015  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8016  tHomog hom=testHomog;
8017  if (w_u!=NULL)
8018  {
8019    w_u=ivCopy(w_u);
8020    hom=isHomog;
8021  }
8022  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
8023  if (w_v!=NULL)
8024  {
8025    w_v=ivCopy(w_v);
8026    hom=isHomog;
8027  }
8028  if ((w_u!=NULL) && (w_v==NULL))
8029    w_v=ivCopy(w_u);
8030  if ((w_v!=NULL) && (w_u==NULL))
8031    w_u=ivCopy(w_v);
8032  if (w_u!=NULL)
8033  {
8034     if ((*w_u).compare((w_v))!=0)
8035     {
8036       WarnS("incompatible weights");
8037       delete w_u; w_u=NULL;
8038       hom=testHomog;
8039     }
8040     else
8041     {
8042       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
8043       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
8044       {
8045         WarnS("wrong weights");
8046         delete w_u; w_u=NULL;
8047         hom=testHomog;
8048       }
8049     }
8050  }
8051  idhdl h=(idhdl)w->data;
8052  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u, &(h->data.umatrix),alg);
8053  if (w_u!=NULL)
8054  {
8055    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
8056  }
8057  delete w_v;
8058  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
8059  return FALSE;
8060}
8061static BOOLEAN jjNAMES0(leftv res, leftv)
8062{
8063  res->data=(void *)ipNameList(IDROOT);
8064  return FALSE;
8065}
8066static BOOLEAN jjOPTION_PL(leftv res, leftv v)
8067{
8068  if(v==NULL)
8069  {
8070    res->data=(char *)showOption();
8071    return FALSE;
8072  }
8073  res->rtyp=NONE;
8074  return setOption(res,v);
8075}
8076static BOOLEAN jjREDUCE4(leftv res, leftv u)
8077{
8078  leftv u1=u;
8079  leftv u2=u1->next;
8080  leftv u3=u2->next;
8081  leftv u4=u3->next;
8082  int u1t=u1->Typ(); if (u1t==BUCKET_CMD) u1t=POLY_CMD;
8083  int u2t=u2->Typ(); if (u2t==BUCKET_CMD) u2t=POLY_CMD;
8084  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
8085  {
8086    int save_d=Kstd1_deg;
8087    Kstd1_deg=(int)(long)u3->Data();
8088    kModW=(intvec *)u4->Data();
8089    BITSET save2;
8090    SI_SAVE_OPT2(save2);
8091    si_opt_2|=Sy_bit(V_DEG_STOP);
8092    u2->next=NULL;
8093    BOOLEAN r=jjCALL2ARG(res,u);
8094    kModW=NULL;
8095    Kstd1_deg=save_d;
8096    SI_RESTORE_OPT2(save2);
8097    u->next->next=u3;
8098    return r;
8099  }
8100  else
8101  if((u1t==IDEAL_CMD)&&(u2t==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8102     (u4->Typ()==INT_CMD))
8103  {
8104    assumeStdFlag(u3);
8105    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
8106    {
8107      WerrorS("2nd argument must be a diagonal matrix of units");
8108      return TRUE;
8109    }
8110    res->data=(char*)redNF(
8111                           idCopy((ideal)u3->Data()),
8112                           idCopy((ideal)u1->Data()),
8113                           mp_Copy((matrix)u2->Data(), currRing),
8114                           (int)(long)u4->Data()
8115                          );
8116    return FALSE;
8117  }
8118  else
8119  if((u1t==POLY_CMD)&&(u2t==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8120     (u4->Typ()==INT_CMD))
8121  {
8122    poly u1p;
8123    if (u1->Typ()==BUCKET_CMD) u1p=sBucketPeek((sBucket_pt)u1->Data());
8124    else                     u1p=(poly)u1->Data();
8125    poly u2p;
8126    if (u2->Typ()==BUCKET_CMD) u2p=sBucketPeek((sBucket_pt)u2->Data());
8127    else                     u2p=(poly)u2->Data();
8128    assumeStdFlag(u3);
8129    if(!pIsUnit(u2p))
8130    {
8131      WerrorS("2nd argument must be a unit");
8132      return TRUE;
8133    }
8134    res->rtyp=POLY_CMD;
8135    res->data=(char*)redNF((ideal)u3->CopyD(),pCopy(u1p),
8136                           pCopy(u2p),(int)(long)u4->Data());
8137    return FALSE;
8138  }
8139  else
8140  {
8141    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
8142    Werror("%s(`ideal`,`matrix`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
8143    Werror("%s(`poly`,`poly`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
8144    return TRUE;
8145  }
8146}
8147static BOOLEAN jjREDUCE5(leftv res, leftv u)
8148{
8149  leftv u1=u;
8150  leftv u2=u1->next;
8151  leftv u3=u2->next;
8152  leftv u4=u3->next;
8153  leftv u5=u4->next;
8154  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8155     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
8156  {
8157    assumeStdFlag(u3);
8158    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
8159    {
8160      WerrorS("2nd argument must be a diagonal matrix of units");
8161      return TRUE;
8162    }
8163    res->data=(char*)redNF(
8164                           idCopy((ideal)u3->Data()),
8165                           idCopy((ideal)u1->Data()),
8166                           mp_Copy((matrix)u2->Data(),currRing),
8167                           (int)(long)u4->Data(),
8168                           (intvec*)u5->Data()
8169                          );
8170    return FALSE;
8171  }
8172  else
8173  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8174     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
8175  {
8176    assumeStdFlag(u3);
8177    if(!pIsUnit((poly)u2->Data()))
8178    {
8179      WerrorS("2nd argument must be a unit");
8180      return TRUE;
8181    }
8182    res->rtyp=POLY_CMD;
8183    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
8184                           pCopy((poly)u2->Data()),
8185                           (int)(long)u4->Data(),(intvec*)u5->Data());
8186    return FALSE;
8187  }
8188  else
8189  {
8190    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
8191           Tok2Cmdname(iiOp));
8192    return TRUE;
8193  }
8194}
8195static BOOLEAN jjRESERVED0(leftv, leftv)
8196{
8197  unsigned i=1;
8198  unsigned nCount = (sArithBase.nCmdUsed-1)/3;
8199  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
8200  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
8201  //      sArithBase.nCmdAllocated);
8202  for(i=0; i<nCount; i++)
8203  {
8204    Print("%-20s",sArithBase.sCmds[i+1].name);
8205    if(i+1+nCount<sArithBase.nCmdUsed)
8206      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
8207    if(i+1+2*nCount<sArithBase.nCmdUsed)
8208      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
8209    //if ((i%3)==1) PrintLn();
8210    PrintLn();
8211  }
8212  PrintLn();
8213  printBlackboxTypes();
8214  return FALSE;
8215}
8216
8217static BOOLEAN jjRESERVEDLIST0(leftv res, leftv)
8218{
8219  unsigned i=1;
8220  int l = 0;
8221  int k = 0;
8222  lists L = (lists)omAllocBin(slists_bin);
8223  struct blackbox_list *bb_list = NULL;
8224  unsigned nCount = (sArithBase.nCmdUsed-1) / 3;
8225
8226  if ((3*nCount) < sArithBase.nCmdUsed)
8227  {
8228    nCount++;
8229  }
8230  bb_list = getBlackboxTypes();
8231  // count the  number of entries;
8232  for (i=0; i<nCount; i++)
8233  {
8234    l++;
8235    if (i + 1 + nCount < sArithBase.nCmdUsed)
8236    {
8237      l++;
8238    }
8239    if(i+1+2*nCount<sArithBase.nCmdUsed)
8240    {
8241      l++;
8242    }
8243  }
8244  for (i = 0; i < bb_list->count; i++)
8245  {
8246    if (bb_list->list[i] != NULL)
8247    {
8248      l++;
8249    }
8250  }
8251  // initiate list
8252  L->Init(l);
8253  k = 0;
8254  for (i=0; i<nCount; i++)
8255  {
8256    L->m[k].rtyp = STRING_CMD;
8257    L->m[k].data = omStrDup(sArithBase.sCmds[i+1].name);
8258    k++;
8259    // Print("%-20s", sArithBase.sCmds[i+1].name);
8260    if (i + 1 + nCount < sArithBase.nCmdUsed)
8261    {
8262      L->m[k].rtyp = STRING_CMD;
8263      L->m[k].data = omStrDup(sArithBase.sCmds[i+1+nCount].name);
8264      k++;
8265      // Print("%-20s", sArithBase.sCmds[i+1 + nCount].name);
8266    }
8267    if(i+1+2*nCount<sArithBase.nCmdUsed)
8268    {
8269      L->m[k].rtyp = STRING_CMD;
8270      L->m[k].data = omStrDup(sArithBase.sCmds[i+1+2*nCount].name);
8271      k++;
8272      // Print("%-20s", sArithBase.sCmds[i+1+2*nCount].name);
8273    }
8274    // PrintLn();
8275  }
8276
8277  // assign blackbox types
8278  for (i = 0; i < bb_list->count; i++)
8279  {
8280    if (bb_list->list[i] != NULL)
8281    {
8282      L->m[k].rtyp = STRING_CMD;
8283      // already used strdup in getBlackBoxTypes
8284      L->m[k].data = bb_list->list[i];
8285      k++;
8286    }
8287  }
8288  // free the struct (not the list entries itself, which were allocated
8289  // by strdup)
8290  omfree(bb_list->list);
8291  omfree(bb_list);
8292
8293  // pass the resultant list to the res datastructure
8294  res->data=(void *)L;
8295
8296  return FALSE;
8297}
8298static BOOLEAN jjSTRING_PL(leftv res, leftv v)
8299{
8300  if (v == NULL)
8301  {
8302    res->data = omStrDup("");
8303    return FALSE;
8304  }
8305  int n = v->listLength();
8306  if (n == 1)
8307  {
8308    res->data = v->String();
8309    return FALSE;
8310  }
8311
8312  char** slist = (char**) omAlloc(n*sizeof(char*));
8313  int i, j;
8314
8315  for (i=0, j=0; i<n; i++, v = v ->next)
8316  {
8317    slist[i] = v->String();
8318    assume(slist[i] != NULL);
8319    j+=strlen(slist[i]);
8320  }
8321  char* s = (char*) omAlloc((j+1)*sizeof(char));
8322  *s='\0';
8323  for (i=0;i<n;i++)
8324  {
8325    strcat(s, slist[i]);
8326    omFree(slist[i]);
8327  }
8328  omFreeSize(slist, n*sizeof(char*));
8329  res->data = s;
8330  return FALSE;
8331}
8332static BOOLEAN jjTEST(leftv, leftv v)
8333{
8334  do
8335  {
8336    if (v->Typ()!=INT_CMD)
8337      return TRUE;
8338    test_cmd((int)(long)v->Data());
8339    v=v->next;
8340  }
8341  while (v!=NULL);
8342  return FALSE;
8343}
8344
8345#if defined(__alpha) && !defined(linux)
8346extern "C"
8347{
8348  void usleep(unsigned long usec);
8349};
8350#endif
8351static BOOLEAN jjFactModD_M(leftv res, leftv v)
8352{
8353  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
8354     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
8355
8356     valid argument lists:
8357     - (poly h, int d),
8358     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
8359     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
8360                                                          in list of ring vars,
8361     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
8362                                                optional: all 4 optional args
8363     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
8364      by singclap_factorize and h(0, y)
8365      has exactly two distinct monic factors [possibly with exponent > 1].)
8366     result:
8367     - list with the two factors f and g such that
8368       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
8369
8370  poly h      = NULL;
8371  int  d      =    1;
8372  poly f0     = NULL;
8373  poly g0     = NULL;
8374  int  xIndex =    1;   /* default index if none provided */
8375  int  yIndex =    2;   /* default index if none provided */
8376
8377  leftv u = v; int factorsGiven = 0;
8378  if ((u == NULL) || (u->Typ() != POLY_CMD))
8379  {
8380    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8381    return TRUE;
8382  }
8383  else h = (poly)u->Data();
8384  u = u->next;
8385  if ((u == NULL) || (u->Typ() != INT_CMD))
8386  {
8387    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8388    return TRUE;
8389  }
8390  else d = (int)(long)u->Data();
8391  u = u->next;
8392  if ((u != NULL) && (u->Typ() == POLY_CMD))
8393  {
8394    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
8395    {
8396      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8397      return TRUE;
8398    }
8399    else
8400    {
8401      f0 = (poly)u->Data();
8402      g0 = (poly)u->next->Data();
8403      factorsGiven = 1;
8404      u = u->next->next;
8405    }
8406  }
8407  if ((u != NULL) && (u->Typ() == INT_CMD))
8408  {
8409    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
8410    {
8411      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8412      return TRUE;
8413    }
8414    else
8415    {
8416      xIndex = (int)(long)u->Data();
8417      yIndex = (int)(long)u->next->Data();
8418      u = u->next->next;
8419    }
8420  }
8421  if (u != NULL)
8422  {
8423    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8424    return TRUE;
8425  }
8426
8427  /* checks for provided arguments */
8428  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
8429  {
8430    WerrorS("expected non-constant polynomial argument(s)");
8431    return TRUE;
8432  }
8433  int n = rVar(currRing);
8434  if ((xIndex < 1) || (n < xIndex))
8435  {
8436    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
8437    return TRUE;
8438  }
8439  if ((yIndex < 1) || (n < yIndex))
8440  {
8441    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
8442    return TRUE;
8443  }
8444  if (xIndex == yIndex)
8445  {
8446    WerrorS("expected distinct indices for variables x and y");
8447    return TRUE;
8448  }
8449
8450  /* computation of f0 and g0 if missing */
8451  if (factorsGiven == 0)
8452  {
8453    poly h0 = pSubst(pCopy(h), xIndex, NULL);
8454    intvec* v = NULL;
8455    ideal i = singclap_factorize(h0, &v, 0,currRing);
8456
8457    ivTest(v);
8458
8459    if (i == NULL) return TRUE;
8460
8461    idTest(i);
8462
8463    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
8464    {
8465      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
8466      return TRUE;
8467    }
8468    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
8469    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
8470    idDelete(&i);
8471  }
8472
8473  poly f; poly g;
8474  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
8475  lists L = (lists)omAllocBin(slists_bin);
8476  L->Init(2);
8477  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
8478  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
8479  res->rtyp = LIST_CMD;
8480  res->data = (char*)L;
8481  return FALSE;
8482}
8483static BOOLEAN jjSTATUS_M(leftv res, leftv v)
8484{
8485  if ((v->Typ() != LINK_CMD) ||
8486      (v->next->Typ() != STRING_CMD) ||
8487      (v->next->next->Typ() != STRING_CMD) ||
8488      (v->next->next->next->Typ() != INT_CMD))
8489    return TRUE;
8490  jjSTATUS3(res, v, v->next, v->next->next);
8491#if defined(HAVE_USLEEP)
8492  if (((long) res->data) == 0L)
8493  {
8494    int i_s = (int)(long) v->next->next->next->Data();
8495    if (i_s > 0)
8496    {
8497      usleep((int)(long) v->next->next->next->Data());
8498      jjSTATUS3(res, v, v->next, v->next->next);
8499    }
8500  }
8501#elif defined(HAVE_SLEEP)
8502  if (((int) res->data) == 0)
8503  {
8504    int i_s = (int) v->next->next->next->Data();
8505    if (i_s > 0)
8506    {
8507      si_sleep((is - 1)/1000000 + 1);
8508      jjSTATUS3(res, v, v->next, v->next->next);
8509    }
8510  }
8511#endif
8512  return FALSE;
8513}
8514static BOOLEAN jjSUBST_M(leftv res, leftv u)
8515{
8516  leftv v = u->next; // number of args > 0
8517  if (v==NULL) return TRUE;
8518  leftv w = v->next;
8519  if (w==NULL) return TRUE;
8520  leftv rest = w->next;
8521
8522  u->next = NULL;
8523  v->next = NULL;
8524  w->next = NULL;
8525  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
8526  if ((rest!=NULL) && (!b))
8527  {
8528    leftv tmp_next=res->next;
8529    res->next=rest;
8530    sleftv tmp_res;
8531    tmp_res.Init();
8532    b = iiExprArithM(&tmp_res,res,iiOp);
8533    memcpy(res,&tmp_res,sizeof(tmp_res));
8534    res->next=tmp_next;
8535  }
8536  u->next = v;
8537  v->next = w;
8538  // rest was w->next, but is already cleaned
8539  return b;
8540}
8541static BOOLEAN jjQRDS(leftv res, leftv INPUT)
8542{
8543  if ((INPUT->Typ() != MATRIX_CMD) ||
8544      (INPUT->next->Typ() != NUMBER_CMD) ||
8545      (INPUT->next->next->Typ() != NUMBER_CMD) ||
8546      (INPUT->next->next->next->Typ() != NUMBER_CMD))
8547  {
8548    WerrorS("expected (matrix, number, number, number) as arguments");
8549    return TRUE;
8550  }
8551  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
8552  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
8553                                    (number)(v->Data()),
8554                                    (number)(w->Data()),
8555                                    (number)(x->Data()));
8556  return FALSE;
8557}
8558static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
8559{ ideal result;
8560  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
8561  leftv v = u->next;  /* one additional polynomial or ideal */
8562  leftv h = v->next;  /* Hilbert vector */
8563  leftv w = h->next;  /* weight vector */
8564  assumeStdFlag(u);
8565  ideal i1=(ideal)(u->Data());
8566  ideal i0;
8567  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
8568  || (h->Typ()!=INTVEC_CMD)
8569  || (w->Typ()!=INTVEC_CMD))
8570  {
8571    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8572    return TRUE;
8573  }
8574  intvec *vw=(intvec *)w->Data(); // weights of vars
8575  /* merging std_hilb_w and std_1 */
8576  if (vw->length()!=currRing->N)
8577  {
8578    Werror("%d weights for %d variables",vw->length(),currRing->N);
8579    return TRUE;
8580  }
8581  int r=v->Typ();
8582  BOOLEAN cleanup_i0=FALSE;
8583  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
8584  {
8585    i0=idInit(1,i1->rank);
8586    i0->m[0]=(poly)v->Data();
8587    cleanup_i0=TRUE;
8588  }
8589  else if (r==IDEAL_CMD)/* IDEAL */
8590  {
8591    i0=(ideal)v->Data();
8592  }
8593  else
8594  {
8595    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8596    return TRUE;
8597  }
8598  int ii0=idElem(i0);
8599  i1 = idSimpleAdd(i1,i0);
8600  if (cleanup_i0)
8601  {
8602    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
8603    idDelete(&i0);
8604  }
8605  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8606  tHomog hom=testHomog;
8607  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
8608  if (ww!=NULL)
8609  {
8610    if (!idTestHomModule(i1,currRing->qideal,ww))
8611    {
8612      WarnS("wrong weights");
8613      ww=NULL;
8614    }
8615    else
8616    {
8617      ww=ivCopy(ww);
8618      hom=isHomog;
8619    }
8620  }
8621  BITSET save1;
8622  SI_SAVE_OPT1(save1);
8623  si_opt_1|=Sy_bit(OPT_SB_1);
8624  result=kStd(i1,
8625              currRing->qideal,
8626              hom,
8627              &ww,                  // module weights
8628              (intvec *)h->Data(),  // hilbert series
8629              0,                    // syzComp, whatever it is...
8630              IDELEMS(i1)-ii0,      // new ideal
8631              vw);                  // weights of vars
8632  SI_RESTORE_OPT1(save1);
8633  idDelete(&i1);
8634  idSkipZeroes(result);
8635  res->data = (char *)result;
8636  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
8637  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
8638  return FALSE;
8639}
8640
8641static BOOLEAN jjRING_PL(leftv res, leftv a)
8642{
8643  //Print("construct ring\n");
8644  if (a->Typ()!=CRING_CMD)
8645  {
8646    WerrorS("expected `cring` [ `id` ... ]");
8647    return TRUE;
8648  }
8649  assume(a->next!=NULL);
8650  leftv names=a->next;
8651  int N=names->listLength();
8652  char **n=(char**)omAlloc0(N*sizeof(char*));
8653  for(int i=0; i<N;i++,names=names->next)
8654  {
8655    n[i]=(char *)names->Name();
8656  }
8657  coeffs cf=(coeffs)a->CopyD();
8658  res->data=rDefault(cf,N,n, ringorder_dp);
8659  omFreeSize(n,N*sizeof(char*));
8660  return FALSE;
8661}
8662
8663static Subexpr jjMakeSub(leftv e)
8664{
8665  assume( e->Typ()==INT_CMD );
8666  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
8667  r->start =(int)(long)e->Data();
8668  return r;
8669}
8670static BOOLEAN jjRESTART(leftv, leftv u)
8671{
8672  int c=(int)(long)u->Data();
8673  switch(c)
8674  {
8675    case 0:{
8676        PrintS("delete all variables\n");
8677        killlocals(0);
8678        WerrorS("restarting...");
8679        break;
8680      };
8681    default: WerrorS("not implemented");
8682  }
8683  return FALSE;
8684}
8685#define D(A)    (A)
8686#define NULL_VAL NULL
8687#define IPARITH
8688#include "table.h"
8689
8690#include "iparith.inc"
8691
8692/*=================== operations with 2 args. ============================*/
8693/* must be ordered: first operations for chars (infix ops),
8694 * then alphabetically */
8695
8696static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
8697                                    BOOLEAN proccall,
8698                                    const struct sValCmd2* dA2,
8699                                    int at, int bt,
8700                                    const struct sConvertTypes *dConvertTypes)
8701{
8702  BOOLEAN call_failed=FALSE;
8703
8704  if (!errorreported)
8705  {
8706    int i=0;
8707    iiOp=op;
8708    while (dA2[i].cmd==op)
8709    {
8710      if ((at==dA2[i].arg1)
8711      && (bt==dA2[i].arg2))
8712      {
8713        res->rtyp=dA2[i].res;
8714        if (currRing!=NULL)
8715        {
8716          if (check_valid(dA2[i].valid_for,op)) break;
8717        }
8718        else
8719        {
8720          if (RingDependend(dA2[i].res))
8721          {
8722            WerrorS("no ring active (3)");
8723            break;
8724          }
8725        }
8726        if (traceit&TRACE_CALL)
8727          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
8728        if ((call_failed=dA2[i].p(res,a,b)))
8729        {
8730          break;// leave loop, goto error handling
8731        }
8732        a->CleanUp();
8733        b->CleanUp();
8734        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8735        return FALSE;
8736      }
8737      i++;
8738    }
8739    // implicite type conversion ----------------------------------------------
8740    if (dA2[i].cmd!=op)
8741    {
8742      int ai,bi;
8743      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8744      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8745      BOOLEAN failed=FALSE;
8746      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8747      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8748      while (dA2[i].cmd==op)
8749      {
8750        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8751        if ((dA2[i].valid_for & NO_CONVERSION)==0)
8752        {
8753          if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8754          {
8755            if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8756            {
8757              res->rtyp=dA2[i].res;
8758              if (currRing!=NULL)
8759              {
8760                if (check_valid(dA2[i].valid_for,op)) break;
8761              }
8762              else
8763              {
8764                if (RingDependend(dA2[i].res))
8765                {
8766                  WerrorS("no ring active (4)");
8767                  break;
8768                }
8769              }
8770              if (traceit&TRACE_CALL)
8771                Print("call %s(%s,%s)\n",iiTwoOps(op),
8772                Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8773              failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8774              || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8775              || (call_failed=dA2[i].p(res,an,bn)));
8776              // everything done, clean up temp. variables
8777              if (failed)
8778              {
8779                // leave loop, goto error handling
8780                break;
8781              }
8782              else
8783              {
8784                // everything ok, clean up and return
8785                an->CleanUp();
8786                bn->CleanUp();
8787                omFreeBin((ADDRESS)an, sleftv_bin);
8788                omFreeBin((ADDRESS)bn, sleftv_bin);
8789                return FALSE;
8790              }
8791            }
8792          }
8793        }
8794        i++;
8795      }
8796      an->CleanUp();
8797      bn->CleanUp();
8798      omFreeBin((ADDRESS)an, sleftv_bin);
8799      omFreeBin((ADDRESS)bn, sleftv_bin);
8800    }
8801    // error handling ---------------------------------------------------
8802    const char *s=NULL;
8803    if (!errorreported)
8804    {
8805      if ((at==0) && (a->Fullname()!=sNoName_fe))
8806      {
8807        s=a->Fullname();
8808      }
8809      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8810      {
8811        s=b->Fullname();
8812      }
8813      if (s!=NULL)
8814        Werror("`%s` is not defined",s);
8815      else
8816      {
8817        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8818        s = iiTwoOps(op);
8819        if (proccall)
8820        {
8821          Werror("%s(`%s`,`%s`) failed"
8822                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8823        }
8824        else
8825        {
8826          Werror("`%s` %s `%s` failed"
8827                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8828        }
8829        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8830        {
8831          while (dA2[i].cmd==op)
8832          {
8833            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8834            && (dA2[i].res!=0)
8835            && (dA2[i].p!=jjWRONG2))
8836            {
8837              if (proccall)
8838                Werror("expected %s(`%s`,`%s`)"
8839                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8840              else
8841                Werror("expected `%s` %s `%s`"
8842                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8843            }
8844            i++;
8845          }
8846        }
8847      }
8848    }
8849    a->CleanUp();
8850    b->CleanUp();
8851    res->rtyp = UNKNOWN;
8852  }
8853  return TRUE;
8854}
8855BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8856                                    const struct sValCmd2* dA2,
8857                                    int at,
8858                                    const struct sConvertTypes *dConvertTypes)
8859{
8860  res->Init();
8861  leftv b=a->next;
8862  a->next=NULL;
8863  int bt=b->Typ();
8864  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8865  a->next=b;
8866  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8867  return bo;
8868}
8869BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8870{
8871  res->Init();
8872
8873  if (!errorreported)
8874  {
8875#ifdef SIQ
8876    if (siq>0)
8877    {
8878      //Print("siq:%d\n",siq);
8879      command d=(command)omAlloc0Bin(sip_command_bin);
8880      memcpy(&d->arg1,a,sizeof(sleftv));
8881      a->Init();
8882      memcpy(&d->arg2,b,sizeof(sleftv));
8883      b->Init();
8884      d->argc=2;
8885      d->op=op;
8886      res->data=(char *)d;
8887      res->rtyp=COMMAND;
8888      return FALSE;
8889    }
8890#endif
8891    int at=a->Typ();
8892    int bt=b->Typ();
8893    // handling bb-objects ----------------------------------------------------
8894    if (at>MAX_TOK)
8895    {
8896      blackbox *bb=getBlackboxStuff(at);
8897      if (bb!=NULL)
8898      {
8899        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8900        //else: no op defined, try the default
8901      }
8902      else
8903      return TRUE;
8904    }
8905    else if ((bt>MAX_TOK)&&(op!='('))
8906    {
8907      blackbox *bb=getBlackboxStuff(bt);
8908      if (bb!=NULL)
8909      {
8910        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8911        // else: no op defined
8912      }
8913      else
8914      return TRUE;
8915    }
8916    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8917    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8918  }
8919  a->CleanUp();
8920  b->CleanUp();
8921  return TRUE;
8922}
8923
8924/*==================== operations with 1 arg. ===============================*/
8925/* must be ordered: first operations for chars (infix ops),
8926 * then alphabetically */
8927
8928BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, const struct sValCmd1* dA1, int at, const struct sConvertTypes *dConvertTypes)
8929{
8930  res->Init();
8931  BOOLEAN call_failed=FALSE;
8932
8933  if (!errorreported)
8934  {
8935    BOOLEAN failed=FALSE;
8936    iiOp=op;
8937    int i = 0;
8938    while (dA1[i].cmd==op)
8939    {
8940      if (at==dA1[i].arg)
8941      {
8942        if (currRing!=NULL)
8943        {
8944          if (check_valid(dA1[i].valid_for,op)) break;
8945        }
8946        else
8947        {
8948          if (RingDependend(dA1[i].res))
8949          {
8950            WerrorS("no ring active (5)");
8951            break;
8952          }
8953        }
8954        if (traceit&TRACE_CALL)
8955          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8956        res->rtyp=dA1[i].res;
8957        if ((call_failed=dA1[i].p(res,a)))
8958        {
8959          break;// leave loop, goto error handling
8960        }
8961        if (a->Next()!=NULL)
8962        {
8963          res->next=(leftv)omAllocBin(sleftv_bin);
8964          failed=iiExprArith1(res->next,a->next,op);
8965        }
8966        a->CleanUp();
8967        return failed;
8968      }
8969      i++;
8970    }
8971    // implicite type conversion --------------------------------------------
8972    if (dA1[i].cmd!=op)
8973    {
8974      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8975      i=0;
8976      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8977      while (dA1[i].cmd==op)
8978      {
8979        int ai;
8980        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8981        if ((dA1[i].valid_for & NO_CONVERSION)==0)
8982        {
8983          if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8984          {
8985            if (currRing!=NULL)
8986            {
8987              if (check_valid(dA1[i].valid_for,op)) break;
8988            }
8989            else
8990            {
8991              if (RingDependend(dA1[i].res))
8992              {
8993                WerrorS("no ring active (6)");
8994                break;
8995              }
8996            }
8997            if (traceit&TRACE_CALL)
8998              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8999            res->rtyp=dA1[i].res;
9000            failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
9001            || (call_failed=dA1[i].p(res,an)));
9002            // everything done, clean up temp. variables
9003            if (failed)
9004            {
9005              // leave loop, goto error handling
9006              break;
9007            }
9008            else
9009            {
9010              if (an->Next() != NULL)
9011              {
9012                res->next = (leftv)omAllocBin(sleftv_bin);
9013                failed=iiExprArith1(res->next,an->next,op);
9014              }
9015              // everything ok, clean up and return
9016              an->CleanUp();
9017              omFreeBin((ADDRESS)an, sleftv_bin);
9018              return failed;
9019            }
9020          }
9021        }
9022        i++;
9023      }
9024      an->CleanUp();
9025      omFreeBin((ADDRESS)an, sleftv_bin);
9026    }
9027    // error handling
9028    if (!errorreported)
9029    {
9030      if ((at==0) && (a->Fullname()!=sNoName_fe))
9031      {
9032        Werror("`%s` is not defined",a->Fullname());
9033      }
9034      else
9035      {
9036        i=0;
9037        const char *s = iiTwoOps(op);
9038        Werror("%s(`%s`) failed"
9039                ,s,Tok2Cmdname(at));
9040        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9041        {
9042          while (dA1[i].cmd==op)
9043          {
9044            if ((dA1[i].res!=0)
9045            && (dA1[i].p!=jjWRONG))
9046              Werror("expected %s(`%s`)"
9047                ,s,Tok2Cmdname(dA1[i].arg));
9048            i++;
9049          }
9050        }
9051      }
9052    }
9053    res->rtyp = UNKNOWN;
9054  }
9055  a->CleanUp();
9056  return TRUE;
9057}
9058BOOLEAN iiExprArith1(leftv res, leftv a, int op)
9059{
9060  if (!errorreported)
9061  {
9062    res->Init();
9063#ifdef SIQ
9064    if (siq>0)
9065    {
9066      //Print("siq:%d\n",siq);
9067      command d=(command)omAlloc0Bin(sip_command_bin);
9068      memcpy(&d->arg1,a,sizeof(sleftv));
9069      a->Init();
9070      d->op=op;
9071      d->argc=1;
9072      res->data=(char *)d;
9073      res->rtyp=COMMAND;
9074      return FALSE;
9075    }
9076#endif
9077    int at=a->Typ();
9078    // handling bb-objects ----------------------------------------------------
9079    if(op>MAX_TOK) // explicit type conversion to bb
9080    {
9081      blackbox *bb=getBlackboxStuff(op);
9082      if (bb!=NULL)
9083      {
9084        res->rtyp=op;
9085        res->data=bb->blackbox_Init(bb);
9086        if(!bb->blackbox_Assign(res,a)) return FALSE;
9087      }
9088      else
9089      return TRUE;
9090    }
9091    else if (at>MAX_TOK) // argument is of bb-type
9092    {
9093      blackbox *bb=getBlackboxStuff(at);
9094      if (bb!=NULL)
9095      {
9096        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
9097        // else: no op defined
9098      }
9099      else
9100      return TRUE;
9101    }
9102    if (errorreported) return TRUE;
9103
9104    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
9105    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
9106  }
9107  a->CleanUp();
9108  return TRUE;
9109}
9110
9111/*=================== operations with 3 args. ============================*/
9112/* must be ordered: first operations for chars (infix ops),
9113 * then alphabetically */
9114
9115static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
9116  const struct sValCmd3* dA3, int at, int bt, int ct,
9117  const struct sConvertTypes *dConvertTypes)
9118{
9119  BOOLEAN call_failed=FALSE;
9120
9121  assume(dA3[0].cmd==op);
9122
9123  if (!errorreported)
9124  {
9125    int i=0;
9126    iiOp=op;
9127    while (dA3[i].cmd==op)
9128    {
9129      if ((at==dA3[i].arg1)
9130      && (bt==dA3[i].arg2)
9131      && (ct==dA3[i].arg3))
9132      {
9133        res->rtyp=dA3[i].res;
9134        if (currRing!=NULL)
9135        {
9136          if (check_valid(dA3[i].valid_for,op)) break;
9137        }
9138        if (traceit&TRACE_CALL)
9139          Print("call %s(%s,%s,%s)\n",
9140            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
9141        if ((call_failed=dA3[i].p(res,a,b,c)))
9142        {
9143          break;// leave loop, goto error handling
9144        }
9145        a->CleanUp();
9146        b->CleanUp();
9147        c->CleanUp();
9148        return FALSE;
9149      }
9150      i++;
9151    }
9152    // implicite type conversion ----------------------------------------------
9153    if (dA3[i].cmd!=op)
9154    {
9155      int ai,bi,ci;
9156      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
9157      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
9158      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
9159      BOOLEAN failed=FALSE;
9160      i=0;
9161      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
9162      while (dA3[i].cmd==op)
9163      {
9164        if ((dA3[i].valid_for & NO_CONVERSION)==0)
9165        {
9166          if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
9167          {
9168            if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
9169            {
9170              if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
9171              {
9172                res->rtyp=dA3[i].res;
9173                if (currRing!=NULL)
9174                {
9175                  if (check_valid(dA3[i].valid_for,op)) break;
9176                }
9177                if (traceit&TRACE_CALL)
9178                  Print("call %s(%s,%s,%s)\n",
9179                    iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
9180                    Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
9181                failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
9182                  || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
9183                  || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
9184                  || (call_failed=dA3[i].p(res,an,bn,cn)));
9185                // everything done, clean up temp. variables
9186                if (failed)
9187                {
9188                  // leave loop, goto error handling
9189                  break;
9190                }
9191                else
9192                {
9193                  // everything ok, clean up and return
9194                  an->CleanUp();
9195                  bn->CleanUp();
9196                  cn->CleanUp();
9197                  omFreeBin((ADDRESS)an, sleftv_bin);
9198                  omFreeBin((ADDRESS)bn, sleftv_bin);
9199                  omFreeBin((ADDRESS)cn, sleftv_bin);
9200                  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9201                  return FALSE;
9202                }
9203              }
9204            }
9205          }
9206        }
9207        i++;
9208      }
9209      an->CleanUp();
9210      bn->CleanUp();
9211      cn->CleanUp();
9212      omFreeBin((ADDRESS)an, sleftv_bin);
9213      omFreeBin((ADDRESS)bn, sleftv_bin);
9214      omFreeBin((ADDRESS)cn, sleftv_bin);
9215    }
9216    // error handling ---------------------------------------------------
9217    if (!errorreported)
9218    {
9219      const char *s=NULL;
9220      if ((at==0) && (a->Fullname()!=sNoName_fe))
9221      {
9222        s=a->Fullname();
9223      }
9224      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
9225      {
9226        s=b->Fullname();
9227      }
9228      else if ((ct==0) && (c->Fullname()!=sNoName_fe))
9229      {
9230        s=c->Fullname();
9231      }
9232      if (s!=NULL)
9233        Werror("`%s` is not defined",s);
9234      else
9235      {
9236        i=0;
9237        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
9238        const char *s = iiTwoOps(op);
9239        Werror("%s(`%s`,`%s`,`%s`) failed"
9240                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
9241        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9242        {
9243          while (dA3[i].cmd==op)
9244          {
9245            if(((at==dA3[i].arg1)
9246            ||(bt==dA3[i].arg2)
9247            ||(ct==dA3[i].arg3))
9248            && (dA3[i].res!=0))
9249            {
9250              Werror("expected %s(`%s`,`%s`,`%s`)"
9251                  ,s,Tok2Cmdname(dA3[i].arg1)
9252                  ,Tok2Cmdname(dA3[i].arg2)
9253                  ,Tok2Cmdname(dA3[i].arg3));
9254            }
9255            i++;
9256          }
9257        }
9258      }
9259    }
9260    res->rtyp = UNKNOWN;
9261  }
9262  a->CleanUp();
9263  b->CleanUp();
9264  c->CleanUp();
9265  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9266  return TRUE;
9267}
9268BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
9269{
9270  res->Init();
9271
9272  if (!errorreported)
9273  {
9274#ifdef SIQ
9275    if (siq>0)
9276    {
9277      //Print("siq:%d\n",siq);
9278      command d=(command)omAlloc0Bin(sip_command_bin);
9279      memcpy(&d->arg1,a,sizeof(sleftv));
9280      a->Init();
9281      memcpy(&d->arg2,b,sizeof(sleftv));
9282      b->Init();
9283      memcpy(&d->arg3,c,sizeof(sleftv));
9284      c->Init();
9285      d->op=op;
9286      d->argc=3;
9287      res->data=(char *)d;
9288      res->rtyp=COMMAND;
9289      return FALSE;
9290    }
9291#endif
9292    int at=a->Typ();
9293    // handling bb-objects ----------------------------------------------
9294    if (at>MAX_TOK)
9295    {
9296      blackbox *bb=getBlackboxStuff(at);
9297      if (bb!=NULL)
9298      {
9299        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
9300        // else: no op defined
9301      }
9302      else
9303      return TRUE;
9304      if (errorreported) return TRUE;
9305    }
9306    int bt=b->Typ();
9307    int ct=c->Typ();
9308
9309    iiOp=op;
9310    int i=0;
9311    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
9312    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
9313  }
9314  a->CleanUp();
9315  b->CleanUp();
9316  c->CleanUp();
9317  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9318  return TRUE;
9319}
9320BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
9321                                    const struct sValCmd3* dA3,
9322                                    int at,
9323                                    const struct sConvertTypes *dConvertTypes)
9324{
9325  res->Init();
9326  leftv b=a->next;
9327  a->next=NULL;
9328  int bt=b->Typ();
9329  leftv c=b->next;
9330  b->next=NULL;
9331  int ct=c->Typ();
9332  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9333  b->next=c;
9334  a->next=b;
9335  a->CleanUp(); // to cleanup the chain, content already done
9336  return bo;
9337}
9338/*==================== operations with many arg. ===============================*/
9339/* must be ordered: first operations for chars (infix ops),
9340 * then alphabetically */
9341
9342#if 0 // unused
9343static BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
9344{
9345  // cnt = 0: all
9346  // cnt = 1: only first one
9347  leftv next;
9348  BOOLEAN failed = TRUE;
9349  if(v==NULL) return failed;
9350  res->rtyp = LIST_CMD;
9351  if(cnt) v->next = NULL;
9352  next = v->next;             // saving next-pointer
9353  failed = jjLIST_PL(res, v);
9354  v->next = next;             // writeback next-pointer
9355  return failed;
9356}
9357#endif
9358
9359BOOLEAN iiExprArithM(leftv res, leftv a, int op)
9360{
9361  res->Init();
9362
9363  if (!errorreported)
9364  {
9365#ifdef SIQ
9366    if (siq>0)
9367    {
9368      //Print("siq:%d\n",siq);
9369      command d=(command)omAlloc0Bin(sip_command_bin);
9370      d->op=op;
9371      res->data=(char *)d;
9372      if (a!=NULL)
9373      {
9374        d->argc=a->listLength();
9375        // else : d->argc=0;
9376        memcpy(&d->arg1,a,sizeof(sleftv));
9377        switch(d->argc)
9378        {
9379          case 3:
9380            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
9381            a->next->next->Init();
9382            /* no break */
9383          case 2:
9384            memcpy(&d->arg2,a->next,sizeof(sleftv));
9385            a->next->Init();
9386            a->next->next=d->arg2.next;
9387            d->arg2.next=NULL;
9388            /* no break */
9389          case 1:
9390            a->Init();
9391            a->next=d->arg1.next;
9392            d->arg1.next=NULL;
9393        }
9394        if (d->argc>3) a->next=NULL;
9395        a->name=NULL;
9396        a->rtyp=0;
9397        a->data=NULL;
9398        a->e=NULL;
9399        a->attribute=NULL;
9400        a->CleanUp();
9401      }
9402      res->rtyp=COMMAND;
9403      return FALSE;
9404    }
9405#endif
9406    if ((a!=NULL) && (a->Typ()>MAX_TOK))
9407    {
9408      blackbox *bb=getBlackboxStuff(a->Typ());
9409      if (bb!=NULL)
9410      {
9411        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
9412        // else: no op defined
9413      }
9414      else
9415      return TRUE;
9416      if (errorreported) return TRUE;
9417    }
9418    int args=0;
9419    if (a!=NULL) args=a->listLength();
9420
9421    iiOp=op;
9422    int i=0;
9423    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
9424    while (dArithM[i].cmd==op)
9425    {
9426      if ((args==dArithM[i].number_of_args)
9427      || (dArithM[i].number_of_args==-1)
9428      || ((dArithM[i].number_of_args==-2)&&(args>0)))
9429      {
9430        res->rtyp=dArithM[i].res;
9431        if (currRing!=NULL)
9432        {
9433          if (check_valid(dArithM[i].valid_for,op)) break;
9434        }
9435        if (traceit&TRACE_CALL)
9436          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
9437        if (dArithM[i].p(res,a))
9438        {
9439          break;// leave loop, goto error handling
9440        }
9441        if (a!=NULL) a->CleanUp();
9442        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9443        return FALSE;
9444      }
9445      i++;
9446    }
9447    // error handling
9448    if (!errorreported)
9449    {
9450      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName_fe))
9451      {
9452        Werror("`%s` is not defined",a->Fullname());
9453      }
9454      else
9455      {
9456        const char *s = iiTwoOps(op);
9457        Werror("%s(...) failed",s);
9458      }
9459    }
9460    res->rtyp = UNKNOWN;
9461  }
9462  if (a!=NULL) a->CleanUp();
9463        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9464  return TRUE;
9465}
9466
9467/*=================== general utilities ============================*/
9468int IsCmd(const char *n, int & tok)
9469{
9470  int i;
9471  int an=1;
9472  int en=sArithBase.nLastIdentifier;
9473
9474  loop
9475  //for(an=0; an<sArithBase.nCmdUsed; )
9476  {
9477    if(an>=en-1)
9478    {
9479      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9480      {
9481        i=an;
9482        break;
9483      }
9484      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9485      {
9486        i=en;
9487        break;
9488      }
9489      else
9490      {
9491        // -- blackbox extensions:
9492        // return 0;
9493        return blackboxIsCmd(n,tok);
9494      }
9495    }
9496    i=(an+en)/2;
9497    if (*n < *(sArithBase.sCmds[i].name))
9498    {
9499      en=i-1;
9500    }
9501    else if (*n > *(sArithBase.sCmds[i].name))
9502    {
9503      an=i+1;
9504    }
9505    else
9506    {
9507      int v=strcmp(n,sArithBase.sCmds[i].name);
9508      if(v<0)
9509      {
9510        en=i-1;
9511      }
9512      else if(v>0)
9513      {
9514        an=i+1;
9515      }
9516      else /*v==0*/
9517      {
9518        break;
9519      }
9520    }
9521  }
9522  lastreserved=sArithBase.sCmds[i].name;
9523  tok=sArithBase.sCmds[i].tokval;
9524  if(sArithBase.sCmds[i].alias==2)
9525  {
9526    Warn("outdated identifier `%s` used - please change your code",
9527    sArithBase.sCmds[i].name);
9528    sArithBase.sCmds[i].alias=1;
9529  }
9530  #if 0
9531  if (currRingHdl==NULL)
9532  {
9533    #ifdef SIQ
9534    if (siq<=0)
9535    {
9536    #endif
9537      if ((tok>=BEGIN_RING) && (tok<=END_RING))
9538      {
9539        WerrorS("no ring active");
9540        return 0;
9541      }
9542    #ifdef SIQ
9543    }
9544    #endif
9545  }
9546  #endif
9547  if (!expected_parms)
9548  {
9549    switch (tok)
9550    {
9551      case IDEAL_CMD:
9552      case INT_CMD:
9553      case INTVEC_CMD:
9554      case MAP_CMD:
9555      case MATRIX_CMD:
9556      case MODUL_CMD:
9557      case POLY_CMD:
9558      case PROC_CMD:
9559      case RING_CMD:
9560      case STRING_CMD:
9561        cmdtok = tok;
9562        break;
9563    }
9564  }
9565  return sArithBase.sCmds[i].toktype;
9566}
9567static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
9568{
9569  // user defined types are not in the pre-computed table:
9570  if (op>MAX_TOK) return 0;
9571
9572  int a=0;
9573  int e=len;
9574  int p=len/2;
9575  do
9576  {
9577     if (op==dArithTab[p].cmd) return dArithTab[p].start;
9578     if (op<dArithTab[p].cmd) e=p-1;
9579     else   a = p+1;
9580     p=a+(e-a)/2;
9581  }
9582  while ( a <= e);
9583
9584  // catch missing a cmd:
9585  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
9586  // Print("op %d (%c) unknown",op,op);
9587  return 0;
9588}
9589
9590typedef char si_char_2[2];
9591STATIC_VAR si_char_2 Tok2Cmdname_buf=" ";
9592const char * Tok2Cmdname(int tok)
9593{
9594  if (tok <= 0)
9595  {
9596    return sArithBase.sCmds[0].name;
9597  }
9598  if (tok==ANY_TYPE) return "any_type";
9599  if (tok==COMMAND) return "command";
9600  if (tok==NONE) return "nothing";
9601  if (tok < 128)
9602  {
9603    Tok2Cmdname_buf[0]=(char)tok;
9604    return Tok2Cmdname_buf;
9605  }
9606  //if (tok==IFBREAK) return "if_break";
9607  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
9608  //if (tok==ORDER_VECTOR) return "ordering";
9609  //if (tok==REF_VAR) return "ref";
9610  //if (tok==OBJECT) return "object";
9611  //if (tok==PRINT_EXPR) return "print_expr";
9612  if (tok==IDHDL) return "identifier";
9613  if (tok>MAX_TOK) return getBlackboxName(tok);
9614  unsigned i;
9615  for(i=0; i<sArithBase.nCmdUsed; i++)
9616    //while (sArithBase.sCmds[i].tokval!=0)
9617  {
9618    if ((sArithBase.sCmds[i].tokval == tok)&&
9619        (sArithBase.sCmds[i].alias==0))
9620    {
9621      return sArithBase.sCmds[i].name;
9622    }
9623  }
9624  // try gain for alias/old names:
9625  for(i=0; i<sArithBase.nCmdUsed; i++)
9626  {
9627    if (sArithBase.sCmds[i].tokval == tok)
9628    {
9629      return sArithBase.sCmds[i].name;
9630    }
9631  }
9632  return sArithBase.sCmds[0].name;
9633}
9634
9635
9636/*---------------------------------------------------------------------*/
9637/**
9638 * @brief compares to entry of cmdsname-list
9639
9640 @param[in] a
9641 @param[in] b
9642
9643 @return <ReturnValue>
9644**/
9645/*---------------------------------------------------------------------*/
9646static int _gentable_sort_cmds( const void *a, const void *b )
9647{
9648  cmdnames *pCmdL = (cmdnames*)a;
9649  cmdnames *pCmdR = (cmdnames*)b;
9650
9651  if(a==NULL || b==NULL)             return 0;
9652
9653  /* empty entries goes to the end of the list for later reuse */
9654  if(pCmdL->name==NULL) return 1;
9655  if(pCmdR->name==NULL) return -1;
9656
9657  /* $INVALID$ must come first */
9658  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
9659  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
9660
9661  /* tokval=-1 are reserved names at the end */
9662  if (pCmdL->tokval==-1)
9663  {
9664    if (pCmdR->tokval==-1)
9665       return strcmp(pCmdL->name, pCmdR->name);
9666    /* pCmdL->tokval==-1, pCmdL goes at the end */
9667    return 1;
9668  }
9669  /* pCmdR->tokval==-1, pCmdR goes at the end */
9670  if(pCmdR->tokval==-1) return -1;
9671
9672  return strcmp(pCmdL->name, pCmdR->name);
9673}
9674
9675/*---------------------------------------------------------------------*/
9676/**
9677 * @brief initialisation of arithmetic structured data
9678
9679 @retval 0 on success
9680
9681**/
9682/*---------------------------------------------------------------------*/
9683int iiInitArithmetic()
9684{
9685  //printf("iiInitArithmetic()\n");
9686  memset(&sArithBase, 0, sizeof(sArithBase));
9687  iiInitCmdName();
9688  /* fix last-identifier */
9689#if 0
9690  /* we expect that gentable allready did every thing */
9691  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9692      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
9693    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9694  }
9695#endif
9696  //Print("L=%d\n", sArithBase.nLastIdentifier);
9697
9698  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
9699  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
9700
9701  //iiArithAddCmd("Top", 0,-1,0);
9702
9703
9704  //for(i=0; i<sArithBase.nCmdUsed; i++) {
9705  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
9706  //         sArithBase.sCmds[i].name,
9707  //         sArithBase.sCmds[i].alias,
9708  //         sArithBase.sCmds[i].tokval,
9709  //         sArithBase.sCmds[i].toktype);
9710  //}
9711  //iiArithRemoveCmd("Top");
9712  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
9713  //iiArithRemoveCmd("mygcd");
9714  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
9715  return 0;
9716}
9717
9718int iiArithFindCmd(const char *szName)
9719{
9720  int an=0;
9721  int i = 0,v = 0;
9722  int en=sArithBase.nLastIdentifier;
9723
9724  loop
9725  //for(an=0; an<sArithBase.nCmdUsed; )
9726  {
9727    if(an>=en-1)
9728    {
9729      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
9730      {
9731        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
9732        return an;
9733      }
9734      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
9735      {
9736        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
9737        return en;
9738      }
9739      else
9740      {
9741        //Print("RET- 1\n");
9742        return -1;
9743      }
9744    }
9745    i=(an+en)/2;
9746    if (*szName < *(sArithBase.sCmds[i].name))
9747    {
9748      en=i-1;
9749    }
9750    else if (*szName > *(sArithBase.sCmds[i].name))
9751    {
9752      an=i+1;
9753    }
9754    else
9755    {
9756      v=strcmp(szName,sArithBase.sCmds[i].name);
9757      if(v<0)
9758      {
9759        en=i-1;
9760      }
9761      else if(v>0)
9762      {
9763        an=i+1;
9764      }
9765      else /*v==0*/
9766      {
9767        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9768        return i;
9769      }
9770    }
9771  }
9772  //if(i>=0 && i<sArithBase.nCmdUsed)
9773  //  return i;
9774  //PrintS("RET-2\n");
9775  return -2;
9776}
9777
9778char *iiArithGetCmd( int nPos )
9779{
9780  if(nPos<0) return NULL;
9781  if(nPos<(int)sArithBase.nCmdUsed)
9782    return sArithBase.sCmds[nPos].name;
9783  return NULL;
9784}
9785
9786int iiArithRemoveCmd(const char *szName)
9787{
9788  int nIndex;
9789  if(szName==NULL) return -1;
9790
9791  nIndex = iiArithFindCmd(szName);
9792  if(nIndex<0 || nIndex>=(int)sArithBase.nCmdUsed)
9793  {
9794    Print("'%s' not found (%d)\n", szName, nIndex);
9795    return -1;
9796  }
9797  omFree(sArithBase.sCmds[nIndex].name);
9798  sArithBase.sCmds[nIndex].name=NULL;
9799  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9800        (&_gentable_sort_cmds));
9801  sArithBase.nCmdUsed--;
9802
9803  /* fix last-identifier */
9804  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9805      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9806  {
9807    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9808  }
9809  //Print("L=%d\n", sArithBase.nLastIdentifier);
9810  return 0;
9811}
9812
9813int iiArithAddCmd(
9814  const char *szName,
9815  short nAlias,
9816  short nTokval,
9817  short nToktype,
9818  short nPos
9819  )
9820{
9821  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9822  //       nTokval, nToktype, nPos);
9823  if(nPos>=0)
9824  {
9825    // no checks: we rely on a correct generated code in iparith.inc
9826    assume((unsigned)nPos < sArithBase.nCmdAllocated);
9827    assume(szName!=NULL);
9828    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9829    sArithBase.sCmds[nPos].alias   = nAlias;
9830    sArithBase.sCmds[nPos].tokval  = nTokval;
9831    sArithBase.sCmds[nPos].toktype = nToktype;
9832    sArithBase.nCmdUsed++;
9833    //if(nTokval>0) sArithBase.nLastIdentifier++;
9834  }
9835  else
9836  {
9837    if(szName==NULL) return -1;
9838    int nIndex = iiArithFindCmd(szName);
9839    if(nIndex>=0)
9840    {
9841      Print("'%s' already exists at %d\n", szName, nIndex);
9842      return -1;
9843    }
9844
9845    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9846    {
9847      /* needs to create new slots */
9848      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9849      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9850      if(sArithBase.sCmds==NULL) return -1;
9851      sArithBase.nCmdAllocated++;
9852    }
9853    /* still free slots available */
9854    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9855    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9856    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9857    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9858    sArithBase.nCmdUsed++;
9859
9860    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9861          (&_gentable_sort_cmds));
9862    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9863        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9864    {
9865      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9866    }
9867    //Print("L=%d\n", sArithBase.nLastIdentifier);
9868  }
9869  return 0;
9870}
9871
9872static BOOLEAN check_valid(const int p, const int op)
9873{
9874  if (rIsPluralRing(currRing))
9875  {
9876    if ((p & NC_MASK)==NO_NC)
9877    {
9878      WerrorS("not implemented for non-commutative rings");
9879      return TRUE;
9880    }
9881    else if ((p & NC_MASK)==COMM_PLURAL)
9882    {
9883      Warn("assume commutative subalgebra for cmd `%s` in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9884      return FALSE;
9885    }
9886    /* else, ALLOW_PLURAL */
9887  }
9888  else if (rIsLPRing(currRing))
9889  {
9890    if ((p & ALLOW_LP)==0)
9891    {
9892      Werror("`%s` not implemented for letterplace rings in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9893      return TRUE;
9894    }
9895  }
9896  if (rField_is_Ring(currRing))
9897  {
9898    if ((p & RING_MASK)==0 /*NO_RING*/)
9899    {
9900      WerrorS("not implemented for rings with rings as coeffients");
9901      return TRUE;
9902    }
9903    /* else ALLOW_RING */
9904    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9905    &&(!rField_is_Domain(currRing)))
9906    {
9907      WerrorS("domain required as coeffients");
9908      return TRUE;
9909    }
9910    /* else ALLOW_ZERODIVISOR */
9911    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9912    {
9913      WarnS("considering the image in Q[...]");
9914    }
9915  }
9916  return FALSE;
9917}
9918// --------------------------------------------------------------------
9919static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
9920{
9921  if ((currRing!=NULL)
9922  && rField_is_Ring(currRing)
9923  && (!rField_is_Z(currRing)))
9924  {
9925    WerrorS("not implemented for rings with rings as coeffients (except ZZ)");
9926    return TRUE;
9927  }
9928  coeffs cf;
9929  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
9930  int rl=c->nr+1;
9931  int return_type=c->m[0].Typ();
9932  if ((return_type!=IDEAL_CMD)
9933  && (return_type!=MODUL_CMD)
9934  && (return_type!=MATRIX_CMD)
9935  && (return_type!=POLY_CMD))
9936  {
9937    if((return_type==BIGINT_CMD)
9938    ||(return_type==INT_CMD))
9939      return_type=BIGINT_CMD;
9940    else if (return_type==LIST_CMD)
9941    {
9942      // create a tmp list of the correct size
9943      lists res_l=(lists)omAllocBin(slists_bin);
9944      res_l->Init(rl /*c->nr+1*/);
9945      BOOLEAN bo=FALSE;
9946      int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,CHINREM_CMD);
9947      for (unsigned i=0;i<=(unsigned)c->nr;i++)
9948      {
9949        sleftv tmp;
9950        tmp.Copy(v);
9951        bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],CHINREM_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9952        if (bo) { Werror("chinrem failed for list entry %d",i+1); break;}
9953      }
9954      c->Clean();
9955      res->data=res_l;
9956      res->rtyp=LIST_CMD;
9957      return bo;
9958    }
9959    else
9960    {
9961      c->Clean();
9962      WerrorS("poly/ideal/module/matrix/list expected");
9963      return TRUE;
9964    }
9965  }
9966  if (return_type==BIGINT_CMD)
9967    cf=coeffs_BIGINT;
9968  else
9969  {
9970    cf=currRing->cf;
9971    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
9972      cf=cf->extRing->cf;
9973  }
9974  lists pl=NULL;
9975  intvec *p=NULL;
9976  if (v->Typ()==LIST_CMD)
9977  {
9978    pl=(lists)v->Data();
9979    if (pl->nr!=rl-1)
9980    {
9981      WerrorS("wromg number of primes");
9982      return TRUE;
9983    }
9984  }
9985  else
9986  {
9987    p=(intvec*)v->Data();
9988    if (p->length()!=rl)
9989    {
9990      WerrorS("wromg number of primes");
9991      return TRUE;
9992    }
9993  }
9994  ideal result;
9995  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
9996  number *xx=NULL;
9997  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
9998  int i;
9999  if (return_type!=BIGINT_CMD)
10000  {
10001    for(i=rl-1;i>=0;i--)
10002    {
10003      if (c->m[i].Typ()!=return_type)
10004      {
10005        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
10006        omFree(x); // delete c
10007        return TRUE;
10008      }
10009      if (return_type==POLY_CMD)
10010      {
10011        x[i]=idInit(1,1);
10012        x[i]->m[0]=(poly)c->m[i].CopyD();
10013      }
10014      else
10015      {
10016        x[i]=(ideal)c->m[i].CopyD();
10017      }
10018      //c->m[i].Init();
10019    }
10020  }
10021  else
10022  {
10023    if (nMap==NULL)
10024    {
10025      Werror("not implemented: map bigint -> %s", nCoeffName(cf));
10026      return TRUE;
10027    }
10028    xx=(number *)omAlloc(rl*sizeof(number));
10029    for(i=rl-1;i>=0;i--)
10030    {
10031      if (c->m[i].Typ()==INT_CMD)
10032      {
10033        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
10034      }
10035      else if (c->m[i].Typ()==BIGINT_CMD)
10036      {
10037        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
10038      }
10039      else
10040      {
10041        Werror("bigint expected at pos %d",i+1);
10042        omFree(x); // delete c
10043        omFree(xx); // delete c
10044        return TRUE;
10045      }
10046    }
10047  }
10048  number *q=(number *)omAlloc(rl*sizeof(number));
10049  if (p!=NULL)
10050  {
10051    for(i=rl-1;i>=0;i--)
10052    {
10053      q[i]=n_Init((*p)[i], cf);
10054    }
10055  }
10056  else
10057  {
10058    for(i=rl-1;i>=0;i--)
10059    {
10060      if (pl->m[i].Typ()==INT_CMD)
10061      {
10062        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
10063      }
10064      else if (pl->m[i].Typ()==BIGINT_CMD)
10065      {
10066        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
10067      }
10068      else
10069      {
10070        Werror("bigint expected at pos %d",i+1);
10071        for(i++;i<rl;i++)
10072        {
10073          n_Delete(&(q[i]),cf);
10074        }
10075        omFree(x); // delete c
10076        omFree(q); // delete pl
10077        if (xx!=NULL) omFree(xx); // delete c
10078        return TRUE;
10079      }
10080    }
10081  }
10082  if (return_type==BIGINT_CMD)
10083  {
10084    CFArray i_v(rl);
10085    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,i_v,coeffs_BIGINT);
10086    res->data=(char *)n;
10087  }
10088  else
10089  {
10090    #if 0
10091    #ifdef HAVE_VSPACE
10092    int cpus = (long) feOptValue(FE_OPT_CPUS);
10093    if ((cpus>1) && (rField_is_Q(currRing)))
10094      result=id_ChineseRemainder_0(x,q,rl,currRing); // deletes also x
10095    else
10096    #endif
10097    #endif
10098      result=id_ChineseRemainder(x,q,rl,currRing); // deletes also x
10099    c->Clean();
10100    if ((return_type==POLY_CMD) &&(result!=NULL))
10101    {
10102      res->data=(char *)result->m[0];
10103      result->m[0]=NULL;
10104      idDelete(&result);
10105    }
10106    else
10107      res->data=(char *)result;
10108  }
10109  for(i=rl-1;i>=0;i--)
10110  {
10111    n_Delete(&(q[i]),cf);
10112  }
10113  omFree(q);
10114  res->rtyp=return_type;
10115  return result==NULL;
10116}
10117static BOOLEAN jjFAREY_LI(leftv res, leftv u, leftv v)
10118{
10119  lists c=(lists)u->CopyD();
10120  lists res_l=(lists)omAllocBin(slists_bin);
10121  res_l->Init(c->nr+1);
10122  BOOLEAN bo=FALSE;
10123  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,FAREY_CMD);
10124  for (unsigned i=0;i<=(unsigned)c->nr;i++)
10125  {
10126    sleftv tmp;
10127    tmp.Copy(v);
10128    bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],FAREY_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
10129    if (bo) { Werror("farey failed for list entry %d",i+1); break;}
10130  }
10131  c->Clean();
10132  res->data=res_l;
10133  return bo;
10134}
10135// --------------------------------------------------------------------
10136static int jjCOMPARE_ALL(const void * aa, const void * bb)
10137{
10138  leftv a=(leftv)aa;
10139  int at=a->Typ();
10140  leftv b=(leftv)bb;
10141  int bt=b->Typ();
10142  if (at < bt) return -1;
10143  if (at > bt) return 1;
10144  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,'<');
10145  sleftv tmp;
10146  tmp.Init();
10147  iiOp='<';
10148  BOOLEAN bo=iiExprArith2TabIntern(&tmp,a,'<',b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
10149  if (bo)
10150  {
10151    Werror(" no `<` for %s",Tok2Cmdname(at));
10152    unsigned long ad=(unsigned long)a->Data();
10153    unsigned long bd=(unsigned long)b->Data();
10154    if (ad<bd) return -1;
10155    else if (ad==bd) return 0;
10156    else return 1;
10157  }
10158  else if (tmp.data==NULL) /* not < */
10159  {
10160    iiOp=EQUAL_EQUAL;
10161    tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,EQUAL_EQUAL);
10162    bo=iiExprArith2TabIntern(&tmp,a,EQUAL_EQUAL,b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
10163    if (bo)
10164    {
10165      Werror(" no `==` for %s",Tok2Cmdname(at));
10166      unsigned long ad=(unsigned long)a->Data();
10167      unsigned long bd=(unsigned long)b->Data();
10168      if (ad<bd) return -1;
10169      else if (ad==bd) return 0;
10170      else return 1;
10171    }
10172    else if (tmp.data==NULL) /* not <,== */ return 1;
10173    else return 0;
10174  }
10175  else return -1;
10176}
10177BOOLEAN jjSORTLIST(leftv, leftv arg)
10178{
10179  lists l=(lists)arg->Data();
10180  if (l->nr>0)
10181  {
10182    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
10183  }
10184  return FALSE;
10185}
10186BOOLEAN jjUNIQLIST(leftv, leftv arg)
10187{
10188  lists l=(lists)arg->Data();
10189  if (l->nr>0)
10190  {
10191    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
10192    int i, j, len;
10193    len=l->nr;
10194    i=0;
10195    while(i<len)
10196    {
10197      if(jjCOMPARE_ALL(&(l->m[i]),&(l->m[i+1]))==0)
10198      {
10199        l->m[i].CleanUp();
10200        for(j=i; j<len;j++) l->m[j]=l->m[j+1];
10201        memset(&(l->m[len]),0,sizeof(sleftv));
10202        l->m[len].rtyp=DEF_CMD;
10203        len--;
10204      }
10205      else
10206        i++;
10207    }
10208    //Print("new len:%d\n",len);
10209  }
10210  return FALSE;
10211}
Note: See TracBrowser for help on using the repository browser.