source: git/Singular/iparith.cc @ 2f2b5f2

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