source: git/Singular/iparith.cc @ 6180565

spielwiese
Last change on this file since 6180565 was 6180565, checked in by Hans Schoenemann <hannes@…>, 4 years ago
fix: numerator/denominator
  • Property mode set to 100644
File size: 245.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8//long all_farey=0L;
9//long 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/spectrum/GMPrat.h"
39#include "kernel/groebner_walk/walkProc.h"
40#include "kernel/oswrapper/timer.h"
41#include "kernel/fglm/fglm.h"
42
43#include "kernel/GBEngine/kstdfac.h"
44#include "kernel/GBEngine/syz.h"
45#include "kernel/GBEngine/kstd1.h"
46#include "kernel/GBEngine/units.h"
47#include "kernel/GBEngine/tgb.h"
48
49#include "kernel/preimage.h"
50#include "kernel/polys.h"
51#include "kernel/ideals.h"
52
53#include "Singular/mod_lib.h"
54#include "Singular/fevoices.h"
55#include "Singular/tok.h"
56#include "Singular/ipid.h"
57#include "Singular/sdb.h"
58#include "Singular/subexpr.h"
59#include "Singular/lists.h"
60#include "Singular/maps_ip.h"
61
62#include "Singular/ipconv.h"
63#include "Singular/ipprint.h"
64#include "Singular/attrib.h"
65#include "Singular/links/silink.h"
66#include "Singular/misc_ip.h"
67#include "Singular/linearAlgebra_ip.h"
68
69#include "Singular/number2.h"
70
71#include "Singular/fglm.h"
72
73#include "Singular/blackbox.h"
74#include "Singular/newstruct.h"
75#include "Singular/ipshell.h"
76//#include "kernel/mpr_inout.h"
77#include "reporter/si_signals.h"
78
79#include <ctype.h>
80
81// defaults for all commands: NO_NC | NO_RING | ALLOW_ZERODIVISOR
82
83#ifdef HAVE_PLURAL
84  #include "kernel/GBEngine/ratgring.h"
85  #include "kernel/GBEngine/nc.h"
86  #include "polys/nc/nc.h"
87  #include "polys/nc/sca.h"
88  #define  NC_MASK (3+64)
89#else /* HAVE_PLURAL */
90  #define  NC_MASK     0
91#endif /* HAVE_PLURAL */
92
93#ifdef HAVE_RINGS
94  #define RING_MASK        4
95  #define ZERODIVISOR_MASK 8
96#else
97  #define RING_MASK        0
98  #define ZERODIVISOR_MASK 0
99#endif
100#define ALLOW_PLURAL     1
101#define NO_NC            0
102#define COMM_PLURAL      2
103#define ALLOW_RING       4
104#define NO_RING          0
105#define NO_ZERODIVISOR   8
106#define ALLOW_ZERODIVISOR  0
107#define ALLOW_LP         64
108#define ALLOW_NC         ALLOW_LP|ALLOW_PLURAL
109
110#define ALLOW_ZZ (ALLOW_RING|NO_ZERODIVISOR)
111
112
113// bit 4 for warning, if used at toplevel
114#define WARN_RING        16
115// bit 5: do no try automatic conversions
116#define NO_CONVERSION    32
117
118static BOOLEAN check_valid(const int p, const int op);
119
120/*=============== types =====================*/
121struct sValCmdTab
122{
123  short cmd;
124  short start;
125};
126
127typedef sValCmdTab jjValCmdTab[];
128
129struct _scmdnames
130{
131  char *name;
132  short alias;
133  short tokval;
134  short toktype;
135};
136typedef struct _scmdnames cmdnames;
137
138struct sValCmd1
139{
140  proc1 p;
141  short cmd;
142  short res;
143  short arg;
144  short valid_for;
145};
146
147typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
148struct sValCmd2
149{
150  proc2 p;
151  short cmd;
152  short res;
153  short arg1;
154  short arg2;
155  short valid_for;
156};
157
158typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
159struct sValCmd3
160{
161  proc3 p;
162  short cmd;
163  short res;
164  short arg1;
165  short arg2;
166  short arg3;
167  short valid_for;
168};
169struct sValCmdM
170{
171  proc1 p;
172  short cmd;
173  short res;
174  short number_of_args; /* -1: any, -2: any >0, .. */
175  short valid_for;
176};
177
178typedef struct
179{
180  cmdnames *sCmds;             /**< array of existing commands */
181  struct sValCmd1 *psValCmd1;
182  struct sValCmd2 *psValCmd2;
183  struct sValCmd3 *psValCmd3;
184  struct sValCmdM *psValCmdM;
185  unsigned nCmdUsed;      /**< number of commands used */
186  unsigned nCmdAllocated; /**< number of commands-slots allocated */
187  unsigned nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
188} SArithBase;
189
190/*---------------------------------------------------------------------*
191 * File scope Variables (Variables share by several functions in
192 *                       the same file )
193 *
194 *---------------------------------------------------------------------*/
195STATIC_VAR SArithBase sArithBase;  /**< Base entry for arithmetic */
196
197/*---------------------------------------------------------------------*
198 * Extern Functions declarations
199 *
200 *---------------------------------------------------------------------*/
201static int _gentable_sort_cmds(const void *a, const void *b);
202extern int iiArithRemoveCmd(char *szName);
203extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
204                         short nToktype, short nPos=-1);
205
206/*============= proc =======================*/
207static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
208static Subexpr jjMakeSub(leftv e);
209
210/*============= vars ======================*/
211EXTERN_VAR int cmdtok;
212EXTERN_VAR BOOLEAN expected_parms;
213
214#define ii_div_by_0 "div. by 0"
215
216VAR int iiOp; /* the current operation*/
217
218/*=================== simple helpers =================*/
219static int iin_Int(number &n,coeffs cf)
220{
221  long l=n_Int(n,cf);
222  int i=(int)l;
223  if ((long)i==l) return l;
224  return 0;
225}
226poly pHeadProc(poly p)
227{
228  return pHead(p);
229}
230
231int iiTokType(int op)
232{
233  for (unsigned i=0;i<sArithBase.nCmdUsed;i++)
234  {
235    if (sArithBase.sCmds[i].tokval==op)
236      return sArithBase.sCmds[i].toktype;
237  }
238  return 0;
239}
240
241/*=================== operations with 2 args.: static proc =================*/
242/* must be ordered: first operations for chars (infix ops),
243 * then alphabetically */
244
245static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
246{
247  bigintmat* aa= (bigintmat *)u->Data();
248  int bb = (int)(long)(v->Data());
249  if (errorreported) return TRUE;
250  bigintmat *cc=NULL;
251  switch (iiOp)
252  {
253    case '+': cc=bimAdd(aa,bb); break;
254    case '-': cc=bimSub(aa,bb); break;
255    case '*': cc=bimMult(aa,bb); break;
256  }
257  res->data=(char *)cc;
258  return cc==NULL;
259}
260static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
261{
262  return jjOP_BIM_I(res, v, u);
263}
264static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
265{
266  bigintmat* aa= (bigintmat *)u->Data();
267  number bb = (number)(v->Data());
268  if (errorreported) return TRUE;
269  bigintmat *cc=NULL;
270  switch (iiOp)
271  {
272    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
273  }
274  res->data=(char *)cc;
275  return cc==NULL;
276}
277static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
278{
279  return jjOP_BIM_BI(res, v, u);
280}
281static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
282{
283  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
284  int bb = (int)(long)(v->Data());
285  if (errorreported) return TRUE;
286  switch (iiOp)
287  {
288    case '+': (*aa) += bb; break;
289    case '-': (*aa) -= bb; break;
290    case '*': (*aa) *= bb; break;
291    case '/':
292    case INTDIV_CMD: (*aa) /= bb; break;
293    case '%': (*aa) %= bb; break;
294  }
295  res->data=(char *)aa;
296  return FALSE;
297}
298static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
299{
300  return jjOP_IV_I(res,v,u);
301}
302static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
303{
304  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
305  int bb = (int)(long)(v->Data());
306  int i=si_min(aa->rows(),aa->cols());
307  switch (iiOp)
308  {
309    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
310              break;
311    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
312              break;
313  }
314  res->data=(char *)aa;
315  return FALSE;
316}
317static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
318{
319  return jjOP_IM_I(res,v,u);
320}
321static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
322{
323  int l=(int)(long)v->Data();
324  if (l>=0)
325  {
326    int d=(int)(long)u->Data();
327    intvec *vv=new intvec(l);
328    int i;
329    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
330    res->data=(char *)vv;
331  }
332  return (l<0);
333}
334static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
335{
336  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
337  return FALSE;
338}
339static void jjEQUAL_REST(leftv res,leftv u,leftv v);
340static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
341{
342  intvec*    a = (intvec * )(u->Data());
343  intvec*    b = (intvec * )(v->Data());
344  int r=a->compare(b);
345  switch  (iiOp)
346  {
347    case '<':
348      res->data  = (char *) (r<0);
349      break;
350    case '>':
351      res->data  = (char *) (r>0);
352      break;
353    case LE:
354      res->data  = (char *) (r<=0);
355      break;
356    case GE:
357      res->data  = (char *) (r>=0);
358      break;
359    case EQUAL_EQUAL:
360    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
361      res->data  = (char *) (r==0);
362      break;
363  }
364  jjEQUAL_REST(res,u,v);
365  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
366  return FALSE;
367}
368static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
369{
370  bigintmat*    a = (bigintmat * )(u->Data());
371  bigintmat*    b = (bigintmat * )(v->Data());
372  int r=a->compare(b);
373  switch  (iiOp)
374  {
375    case '<':
376      res->data  = (char *) (r<0);
377      break;
378    case '>':
379      res->data  = (char *) (r>0);
380      break;
381    case LE:
382      res->data  = (char *) (r<=0);
383      break;
384    case GE:
385      res->data  = (char *) (r>=0);
386      break;
387    case EQUAL_EQUAL:
388    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
389      res->data  = (char *) (r==0);
390      break;
391  }
392  jjEQUAL_REST(res,u,v);
393  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
394  return FALSE;
395}
396static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
397{
398  intvec* a = (intvec * )(u->Data());
399  int     b = (int)(long)(v->Data());
400  int r=a->compare(b);
401  switch  (iiOp)
402  {
403    case '<':
404      res->data  = (char *) (r<0);
405      break;
406    case '>':
407      res->data  = (char *) (r>0);
408      break;
409    case LE:
410      res->data  = (char *) (r<=0);
411      break;
412    case GE:
413      res->data  = (char *) (r>=0);
414      break;
415    case EQUAL_EQUAL:
416    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
417      res->data  = (char *) (r==0);
418      break;
419  }
420  jjEQUAL_REST(res,u,v);
421  return FALSE;
422}
423static BOOLEAN jjCOMPARE_MA(leftv res, leftv u, leftv v)
424{
425  //Print("in: >>%s<<\n",my_yylinebuf);
426  matrix a=(matrix)u->Data();
427  matrix b=(matrix)v->Data();
428  int r=mp_Compare(a,b,currRing);
429  switch  (iiOp)
430  {
431    case '<':
432      res->data  = (char *) (long)(r < 0);
433      break;
434    case '>':
435      res->data  = (char *) (long)(r > 0);
436      break;
437    case LE:
438      res->data  = (char *) (long)(r <= 0);
439      break;
440    case GE:
441      res->data  = (char *) (long)(r >= 0);
442      break;
443    case EQUAL_EQUAL:
444    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
445      res->data  = (char *)(long) (r == 0);
446      break;
447  }
448  jjEQUAL_REST(res,u,v);
449  return FALSE;
450}
451static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
452{
453  poly p=(poly)u->Data();
454  poly q=(poly)v->Data();
455  int r=p_Compare(p,q,currRing);
456  switch  (iiOp)
457  {
458    case '<':
459      res->data  = (char *) (r < 0);
460      break;
461    case '>':
462      res->data  = (char *) (r > 0);
463      break;
464    case LE:
465      res->data  = (char *) (r <= 0);
466      break;
467    case GE:
468      res->data  = (char *) (r >= 0);
469      break;
470    //case EQUAL_EQUAL:
471    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
472    //  res->data  = (char *) (r == 0);
473    //  break;
474  }
475  jjEQUAL_REST(res,u,v);
476  return FALSE;
477}
478static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
479{
480  char*    a = (char * )(u->Data());
481  char*    b = (char * )(v->Data());
482  int result = strcmp(a,b);
483  switch  (iiOp)
484  {
485    case '<':
486      res->data  = (char *) (result  < 0);
487      break;
488    case '>':
489      res->data  = (char *) (result  > 0);
490      break;
491    case LE:
492      res->data  = (char *) (result  <= 0);
493      break;
494    case GE:
495      res->data  = (char *) (result  >= 0);
496      break;
497    case EQUAL_EQUAL:
498    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
499      res->data  = (char *) (result  == 0);
500      break;
501  }
502  jjEQUAL_REST(res,u,v);
503  return FALSE;
504}
505static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
506{
507  if (u->Next()!=NULL)
508  {
509    u=u->next;
510    res->next = (leftv)omAllocBin(sleftv_bin);
511    return iiExprArith2(res->next,u,iiOp,v);
512  }
513  else if (v->Next()!=NULL)
514  {
515    v=v->next;
516    res->next = (leftv)omAllocBin(sleftv_bin);
517    return iiExprArith2(res->next,u,iiOp,v);
518  }
519  return FALSE;
520}
521static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
522{
523  int b=(int)(long)u->Data();
524  int e=(int)(long)v->Data();
525  int rc = 1;
526  BOOLEAN overflow=FALSE;
527  if (e >= 0)
528  {
529    if (b==0)
530    {
531      rc=(e==0);
532    }
533    else if ((e==0)||(b==1))
534    {
535      rc= 1;
536    }
537    else if (b== -1)
538    {
539      if (e&1) rc= -1;
540      else     rc= 1;
541    }
542    else
543    {
544      int oldrc;
545      while ((e--)!=0)
546      {
547        oldrc=rc;
548        rc *= b;
549        if (!overflow)
550        {
551          if(rc/b!=oldrc) overflow=TRUE;
552        }
553      }
554      if (overflow)
555        WarnS("int overflow(^), result may be wrong");
556    }
557    res->data = (char *)((long)rc);
558    if (u!=NULL) return jjOP_REST(res,u,v);
559    return FALSE;
560  }
561  else
562  {
563    WerrorS("exponent must be non-negative");
564    return TRUE;
565  }
566}
567static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
568{
569  int e=(int)(long)v->Data();
570  number n=(number)u->Data();
571  if (e>=0)
572  {
573    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
574  }
575  else
576  {
577    WerrorS("exponent must be non-negative");
578    return TRUE;
579  }
580  if (u!=NULL) return jjOP_REST(res,u,v);
581  return FALSE;
582}
583static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
584{
585  int e=(int)(long)v->Data();
586  number n=(number)u->Data();
587  int d=0;
588  if (e<0)
589  {
590    n=nInvers(n);
591    e=-e;
592    d=1;
593  }
594  number r;
595  nPower(n,e,(number*)&r);
596  res->data=(char*)r;
597  if (d) nDelete(&n);
598  if (u!=NULL) return jjOP_REST(res,u,v);
599  return FALSE;
600}
601static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
602{
603  int v_i=(int)(long)v->Data();
604  if (v_i<0)
605  {
606    WerrorS("exponent must be non-negative");
607    return TRUE;
608  }
609  poly u_p=(poly)u->CopyD(POLY_CMD);
610  if ((u_p!=NULL)
611  #ifdef HAVE_SHIFTBBA
612  && (!rIsLPRing(currRing))
613  #endif
614  && ((v_i!=0) &&
615      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i/2)))
616  {
617    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
618                                    pTotaldegree(u_p),v_i,currRing->bitmask/2);
619    pDelete(&u_p);
620    return TRUE;
621  }
622  res->data = (char *)pPower(u_p,v_i);
623  if (u!=NULL) return jjOP_REST(res,u,v);
624  return errorreported; /* pPower may set errorreported via Werror */
625}
626static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
627{
628  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
629  if (u!=NULL) return jjOP_REST(res,u,v);
630  return FALSE;
631}
632static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
633{
634  u=u->next;
635  v=v->next;
636  if (u==NULL)
637  {
638    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
639    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
640    {
641      do
642      {
643        if (res->next==NULL)
644          res->next = (leftv)omAlloc0Bin(sleftv_bin);
645        leftv tmp_v=v->next;
646        v->next=NULL;
647        BOOLEAN b=iiExprArith1(res->next,v,'-');
648        v->next=tmp_v;
649        if (b)
650          return TRUE;
651        v=tmp_v;
652        res=res->next;
653      } while (v!=NULL);
654      return FALSE;
655    }
656    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
657    {
658      res->next = (leftv)omAlloc0Bin(sleftv_bin);
659      res=res->next;
660      res->data = v->CopyD();
661      res->rtyp = v->Typ();
662      v=v->next;
663      if (v==NULL) return FALSE;
664    }
665  }
666  if (v!=NULL)                     /* u<>NULL, v<>NULL */
667  {
668    do
669    {
670      res->next = (leftv)omAlloc0Bin(sleftv_bin);
671      leftv tmp_u=u->next; u->next=NULL;
672      leftv tmp_v=v->next; v->next=NULL;
673      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
674      u->next=tmp_u;
675      v->next=tmp_v;
676      if (b)
677        return TRUE;
678      u=tmp_u;
679      v=tmp_v;
680      res=res->next;
681    } while ((u!=NULL) && (v!=NULL));
682    return FALSE;
683  }
684  loop                             /* u<>NULL, v==NULL */
685  {
686    res->next = (leftv)omAlloc0Bin(sleftv_bin);
687    res=res->next;
688    res->data = u->CopyD();
689    res->rtyp = u->Typ();
690    u=u->next;
691    if (u==NULL) return FALSE;
692  }
693}
694static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
695{
696  switch(u->Typ())
697  {
698    case 0:
699    {
700      int name_err=0;
701      if(isupper(u->name[0]))
702      {
703        const char *c=u->name+1;
704        while((*c!='\0')&&(islower(*c)||(isdigit(*c))||(*c=='_'))) c++;
705        if (*c!='\0')
706          name_err=1;
707        else
708        {
709          Print("%s of type 'ANY'. Trying load.\n", u->name);
710          if(iiTryLoadLib(u, u->name))
711          {
712            Werror("'%s' no such package", u->name);
713            return TRUE;
714          }
715          syMake(u,u->name,NULL);
716        }
717      }
718      else name_err=1;
719      if(name_err)
720      { Werror("'%s' is an invalid package name",u->name);return TRUE;}
721      // and now, after the loading: use next case !!! no break !!!
722    }
723    case PACKAGE_CMD:
724      {
725        package pa=(package)u->Data();
726        if (u->rtyp==IDHDL) pa=IDPACKAGE((idhdl)u->data);
727        if((!pa->loaded)
728        && (pa->language > LANG_TOP))
729        {
730          Werror("'%s' not loaded", u->name);
731          return TRUE;
732        }
733        if(v->rtyp == IDHDL)
734        {
735          v->name = omStrDup(v->name);
736        }
737        else if (v->rtyp!=0)
738        {
739          WerrorS("reserved name with ::");
740          return TRUE;
741        }
742        v->req_packhdl=pa;
743        syMake(v, v->name, pa);
744        memcpy(res, v, sizeof(sleftv));
745        memset(v, 0, sizeof(sleftv));
746      }
747      break;
748    case DEF_CMD:
749      break;
750    default:
751      WerrorS("<package>::<id> expected");
752      return TRUE;
753  }
754  return FALSE;
755}
756static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
757{
758  unsigned int a=(unsigned int)(unsigned long)u->Data();
759  unsigned int b=(unsigned int)(unsigned long)v->Data();
760  unsigned int c=a+b;
761  res->data = (char *)((long)c);
762  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
763  {
764    WarnS("int overflow(+), result may be wrong");
765  }
766  return jjPLUSMINUS_Gen(res,u,v);
767}
768static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
769{
770  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
771  return jjPLUSMINUS_Gen(res,u,v);
772}
773static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
774{
775  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
776  return jjPLUSMINUS_Gen(res,u,v);
777}
778static BOOLEAN jjPLUS_V(leftv res, leftv u, leftv v)
779{
780  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
781  return jjPLUSMINUS_Gen(res,u,v);
782}
783static BOOLEAN jjPLUS_B(leftv res, leftv u, leftv v)
784{
785  //res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
786  sBucket_pt b=sBucketCreate(currRing);
787  poly p=(poly)u->CopyD(POLY_CMD);
788  int l=pLength(p);
789  sBucket_Add_p(b,p,l);
790  p= (poly)v->CopyD(POLY_CMD);
791  l=pLength(p);
792  sBucket_Add_p(b,p,l);
793  res->data=(void*)b;
794  return jjPLUSMINUS_Gen(res,u,v);
795}
796static BOOLEAN jjPLUS_B_P(leftv res, leftv u, leftv v)
797{
798  sBucket_pt b=(sBucket_pt)u->CopyD(BUCKET_CMD);
799  poly p= (poly)v->CopyD(POLY_CMD);
800  int l=pLength(p);
801  sBucket_Add_p(b,p,l);
802  res->data=(void*)b;
803  return jjPLUSMINUS_Gen(res,u,v);
804}
805static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
806{
807  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
808  if (res->data==NULL)
809  {
810     WerrorS("intmat size not compatible");
811     return TRUE;
812  }
813  return jjPLUSMINUS_Gen(res,u,v);
814}
815static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
816{
817  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
818  if (res->data==NULL)
819  {
820    WerrorS("bigintmat/cmatrix not compatible");
821    return TRUE;
822  }
823  return jjPLUSMINUS_Gen(res,u,v);
824}
825static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
826{
827  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
828  res->data = (char *)(mp_Add(A , B, currRing));
829  if (res->data==NULL)
830  {
831     Werror("matrix size not compatible(%dx%d, %dx%d)",
832             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
833     return TRUE;
834  }
835  return jjPLUSMINUS_Gen(res,u,v);
836}
837static BOOLEAN jjPLUS_SM(leftv res, leftv u, leftv v)
838{
839  ideal A=(ideal)u->Data(); ideal B=(ideal)v->Data();
840  res->data = (char *)(sm_Add(A , B, currRing));
841  if (res->data==NULL)
842  {
843     Werror("matrix size not compatible(%dx%d, %dx%d)",
844             (int)A->rank,IDELEMS(A),(int)B->rank,IDELEMS(B));
845     return TRUE;
846  }
847  return jjPLUSMINUS_Gen(res,u,v);
848}
849static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
850{
851  matrix m=(matrix)u->Data();
852  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
853  if (iiOp=='+')
854    res->data = (char *)mp_Add(m , p,currRing);
855  else
856    res->data = (char *)mp_Sub(m , p,currRing);
857  idDelete((ideal *)&p);
858  return jjPLUSMINUS_Gen(res,u,v);
859}
860static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
861{
862  return jjPLUS_MA_P(res,v,u);
863}
864static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
865{
866  char*    a = (char * )(u->Data());
867  char*    b = (char * )(v->Data());
868  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
869  strcpy(r,a);
870  strcat(r,b);
871  res->data=r;
872  return jjPLUSMINUS_Gen(res,u,v);
873}
874static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
875{
876  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
877  return jjPLUSMINUS_Gen(res,u,v);
878}
879static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
880{
881  void *ap=u->Data(); void *bp=v->Data();
882  int aa=(int)(long)ap;
883  int bb=(int)(long)bp;
884  int cc=aa-bb;
885  unsigned int a=(unsigned int)(unsigned long)ap;
886  unsigned int b=(unsigned int)(unsigned long)bp;
887  unsigned int c=a-b;
888  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
889  {
890    WarnS("int overflow(-), result may be wrong");
891  }
892  res->data = (char *)((long)cc);
893  return jjPLUSMINUS_Gen(res,u,v);
894}
895static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
896{
897  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
898  return jjPLUSMINUS_Gen(res,u,v);
899}
900static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
901{
902  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
903  return jjPLUSMINUS_Gen(res,u,v);
904}
905static BOOLEAN jjMINUS_V(leftv res, leftv u, leftv v)
906{
907  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
908  return jjPLUSMINUS_Gen(res,u,v);
909}
910static BOOLEAN jjMINUS_B_P(leftv res, leftv u, leftv v)
911{
912  sBucket_pt b=(sBucket_pt)u->CopyD(BUCKET_CMD);
913  poly p= (poly)v->CopyD(POLY_CMD);
914  int l=pLength(p);
915  p=p_Neg(p,currRing);
916  sBucket_Add_p(b,p,l);
917  res->data=(void*)b;
918  return jjPLUSMINUS_Gen(res,u,v);
919}
920static BOOLEAN jjMINUS_B(leftv res, leftv u, leftv v)
921{
922  sBucket_pt b=sBucketCreate(currRing);
923  poly p=(poly)u->CopyD(POLY_CMD);
924  int l=pLength(p);
925  sBucket_Add_p(b,p,l);
926  p= (poly)v->CopyD(POLY_CMD);
927  p=p_Neg(p,currRing);
928  l=pLength(p);
929  sBucket_Add_p(b,p,l);
930  res->data=(void*)b;
931  return jjPLUSMINUS_Gen(res,u,v);
932}
933static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
934{
935  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
936  if (res->data==NULL)
937  {
938     WerrorS("intmat size not compatible");
939     return TRUE;
940  }
941  return jjPLUSMINUS_Gen(res,u,v);
942}
943static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
944{
945  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
946  if (res->data==NULL)
947  {
948    WerrorS("bigintmat/cmatrix not compatible");
949    return TRUE;
950  }
951  return jjPLUSMINUS_Gen(res,u,v);
952}
953static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
954{
955  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
956  res->data = (char *)(mp_Sub(A , B, currRing));
957  if (res->data==NULL)
958  {
959     Werror("matrix size not compatible(%dx%d, %dx%d)",
960             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
961     return TRUE;
962  }
963  return jjPLUSMINUS_Gen(res,u,v);
964  return FALSE;
965}
966static BOOLEAN jjMINUS_SM(leftv res, leftv u, leftv v)
967{
968  ideal A=(ideal)u->Data(); ideal B=(ideal)v->Data();
969  res->data = (char *)(sm_Sub(A , B, currRing));
970  if (res->data==NULL)
971  {
972     Werror("matrix size not compatible(%dx%d, %dx%d)",
973             (int)A->rank,IDELEMS(A),(int)B->rank,IDELEMS(B));
974     return TRUE;
975  }
976  return jjPLUSMINUS_Gen(res,u,v);
977  return FALSE;
978}
979static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
980{
981  int a=(int)(long)u->Data();
982  int b=(int)(long)v->Data();
983  int64 c=(int64)a * (int64)b;
984  if ((c>INT_MAX)||(c<INT_MIN))
985    WarnS("int overflow(*), result may be wrong");
986  res->data = (char *)((long)((int)c));
987  if ((u->Next()!=NULL) || (v->Next()!=NULL))
988    return jjOP_REST(res,u,v);
989  return FALSE;
990}
991static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
992{
993  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
994  if ((v->next!=NULL) || (u->next!=NULL))
995    return jjOP_REST(res,u,v);
996  return FALSE;
997}
998static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
999{
1000  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
1001  number n=(number)res->data;
1002  nNormalize(n);
1003  res->data=(char *)n;
1004  if ((v->next!=NULL) || (u->next!=NULL))
1005    return jjOP_REST(res,u,v);
1006  return FALSE;
1007}
1008static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
1009{
1010  poly a;
1011  poly b;
1012  if (v->next==NULL)
1013  {
1014    if (u->next==NULL)
1015    {
1016      a=(poly)u->Data(); // works also for VECTOR_CMD
1017      b=(poly)v->Data(); // works also for VECTOR_CMD
1018      if ((a!=NULL) && (b!=NULL)
1019      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask/2)-(long)pTotaldegree(b)))
1020      {
1021        Warn("possible OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
1022          pTotaldegree(a),pTotaldegree(b),currRing->bitmask/2);
1023      }
1024      res->data = (char *)(pp_Mult_qq( a, b, currRing));
1025      return FALSE;
1026    }
1027    // u->next exists: copy v
1028    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
1029    b=pCopy((poly)v->Data());
1030    if ((a!=NULL) && (b!=NULL)
1031    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask/2)))
1032    {
1033      Warn("possible OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
1034          pTotaldegree(a),pTotaldegree(b),currRing->bitmask/2);
1035    }
1036    res->data = (char *)(pMult( a, b));
1037    return jjOP_REST(res,u,v);
1038  }
1039  // v->next exists: copy u
1040  a=pCopy((poly)u->Data());
1041  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
1042  if ((a!=NULL) && (b!=NULL)
1043  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask/2))
1044  {
1045    pDelete(&a);
1046    pDelete(&b);
1047    WerrorS("OVERFLOW");
1048    return TRUE;
1049  }
1050  res->data = (char *)(pMult( a, b));
1051  return jjOP_REST(res,u,v);
1052}
1053static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
1054{
1055  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
1056  if ((v->next!=NULL) || (u->next!=NULL))
1057    return jjOP_REST(res,u,v);
1058  return FALSE;
1059}
1060static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
1061{
1062  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
1063  if (res->data==NULL)
1064  {
1065     WerrorS("intmat size not compatible");
1066     return TRUE;
1067  }
1068  if ((v->next!=NULL) || (u->next!=NULL))
1069    return jjOP_REST(res,u,v);
1070  return FALSE;
1071}
1072static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
1073{
1074  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
1075  if (res->data==NULL)
1076  {
1077    WerrorS("bigintmat/cmatrix not compatible");
1078    return TRUE;
1079  }
1080  if ((v->next!=NULL) || (u->next!=NULL))
1081    return jjOP_REST(res,u,v);
1082  return FALSE;
1083}
1084static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
1085{
1086  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
1087  if (nMap==NULL) return TRUE;
1088  number n=nMap((number)v->Data(),coeffs_BIGINT,currRing->cf);
1089  poly p=pNSet(n);
1090  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1091  res->data = (char *)I;
1092  return FALSE;
1093}
1094static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
1095{
1096  return jjTIMES_MA_BI1(res,v,u);
1097}
1098static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
1099{
1100  poly p=(poly)v->CopyD(POLY_CMD);
1101  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1102  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1103  if (r>0) I->rank=r;
1104  res->data = (char *)I;
1105  return FALSE;
1106}
1107static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1108{
1109  poly p=(poly)u->CopyD(POLY_CMD);
1110  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1111  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1112  if (r>0) I->rank=r;
1113  res->data = (char *)I;
1114  return FALSE;
1115}
1116static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1117{
1118  number n=(number)v->CopyD(NUMBER_CMD);
1119  poly p=pNSet(n);
1120  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1121  return FALSE;
1122}
1123static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1124{
1125  return jjTIMES_MA_N1(res,v,u);
1126}
1127static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1128{
1129  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1130  return FALSE;
1131}
1132static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1133{
1134  return jjTIMES_MA_I1(res,v,u);
1135}
1136static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1137{
1138  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1139  res->data = (char *)mp_Mult(A,B,currRing);
1140  if (res->data==NULL)
1141  {
1142     Werror("matrix size not compatible(%dx%d, %dx%d) in *",
1143             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1144     return TRUE;
1145  }
1146  if ((v->next!=NULL) || (u->next!=NULL))
1147    return jjOP_REST(res,u,v);
1148  return FALSE;
1149}
1150static BOOLEAN jjTIMES_SM(leftv res, leftv u, leftv v)
1151{
1152  ideal A=(ideal)u->Data(); ideal B=(ideal)v->Data();
1153  res->data = (char *)sm_Mult(A,B,currRing);
1154  if (res->data==NULL)
1155  {
1156     Werror("matrix size not compatible(%dx%d, %dx%d) in *",
1157             (int)A->rank,IDELEMS(A),(int)B->rank,IDELEMS(B));
1158     return TRUE;
1159  }
1160  if ((v->next!=NULL) || (u->next!=NULL))
1161    return jjOP_REST(res,u,v);
1162  return FALSE;
1163}
1164static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1165{
1166  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1167  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1168  n_Delete(&h,coeffs_BIGINT);
1169  return FALSE;
1170}
1171static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1172{
1173  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1174  return FALSE;
1175}
1176static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1177{
1178  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1179                       || nEqual((number)u->Data(),(number)v->Data()));
1180  return FALSE;
1181}
1182static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1183{
1184  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1185  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1186  n_Delete(&h,coeffs_BIGINT);
1187  return FALSE;
1188}
1189static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1190{
1191  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1192  return FALSE;
1193}
1194static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1195{
1196  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1197  return FALSE;
1198}
1199static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1200{
1201  return jjGE_BI(res,v,u);
1202}
1203static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1204{
1205  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1206  return FALSE;
1207}
1208static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1209{
1210  return jjGE_N(res,v,u);
1211}
1212static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1213{
1214  return jjGT_BI(res,v,u);
1215}
1216static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1217{
1218  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1219  return FALSE;
1220}
1221static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1222{
1223  return jjGT_N(res,v,u);
1224}
1225static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1226{
1227  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1228  int a= (int)(long)u->Data();
1229  int b= (int)(long)v->Data();
1230  if (b==0)
1231  {
1232    WerrorS(ii_div_by_0);
1233    return TRUE;
1234  }
1235  int c=a%b;
1236  int r=0;
1237  switch (iiOp)
1238  {
1239    case '%':
1240        r=c;            break;
1241    case '/':
1242    case INTDIV_CMD:
1243        r=((a-c) /b);   break;
1244  }
1245  res->data=(void *)((long)r);
1246  return FALSE;
1247}
1248static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1249{
1250  number q=(number)v->Data();
1251  if (n_IsZero(q,coeffs_BIGINT))
1252  {
1253    WerrorS(ii_div_by_0);
1254    return TRUE;
1255  }
1256  q = n_Div((number)u->Data(),q,coeffs_BIGINT);
1257  n_Normalize(q,coeffs_BIGINT);
1258  res->data = (char *)q;
1259  return FALSE;
1260}
1261static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1262{
1263  number q=(number)v->Data();
1264  if (nIsZero(q))
1265  {
1266    WerrorS(ii_div_by_0);
1267    return TRUE;
1268  }
1269  q = nDiv((number)u->Data(),q);
1270  nNormalize(q);
1271  res->data = (char *)q;
1272  return FALSE;
1273}
1274static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1275{
1276  poly q=(poly)v->Data();
1277  poly p=(poly)(u->Data());
1278  res->data=(void*)(pp_Divide(p /*(poly)(u->Data())*/ ,
1279                                         q /*(poly)(v->Data())*/ ,currRing));
1280  if (res->data!=NULL) pNormalize((poly)res->data);
1281  return errorreported; /*there may be errors in p_Divide: div. ny 0, etc.*/
1282}
1283static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1284{
1285  poly q=(poly)v->Data();
1286  if (q==NULL)
1287  {
1288    WerrorS(ii_div_by_0);
1289    return TRUE;
1290  }
1291  matrix m=(matrix)(u->Data());
1292  int r=m->rows();
1293  int c=m->cols();
1294  matrix mm=mpNew(r,c);
1295  unsigned i,j;
1296  for(i=r;i>0;i--)
1297  {
1298    for(j=c;j>0;j--)
1299    {
1300      if (pNext(q)!=NULL)
1301      {
1302        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1303                                           q /*(poly)(v->Data())*/, currRing );
1304      }
1305      else
1306        MATELEM(mm,i,j) = pp_DivideM(MATELEM(m,i,j),q,currRing);
1307    }
1308  }
1309  res->data=(char *)mm;
1310  return FALSE;
1311}
1312static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1313{
1314  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1315  jjEQUAL_REST(res,u,v);
1316  return FALSE;
1317}
1318static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1319{
1320  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1321  jjEQUAL_REST(res,u,v);
1322  return FALSE;
1323}
1324static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1325{
1326  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1327  jjEQUAL_REST(res,u,v);
1328  return FALSE;
1329}
1330static BOOLEAN jjEQUAL_SM(leftv res, leftv u, leftv v)
1331{
1332  res->data = (char *)((long)sm_Equal((ideal)u->Data(),(ideal)v->Data(),currRing));
1333  jjEQUAL_REST(res,u,v);
1334  return FALSE;
1335}
1336static BOOLEAN jjEQUAL_R(leftv res, leftv u, leftv v)
1337{
1338  res->data = (char *)(long)(u->Data()==v->Data());
1339  jjEQUAL_REST(res,u,v);
1340  return FALSE;
1341}
1342static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1343{
1344  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1345  jjEQUAL_REST(res,u,v);
1346  return FALSE;
1347}
1348static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1349{
1350  poly p=(poly)u->Data();
1351  poly q=(poly)v->Data();
1352  res->data = (char *) ((long)pEqualPolys(p,q));
1353  jjEQUAL_REST(res,u,v);
1354  return FALSE;
1355}
1356static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1357{
1358  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1359  {
1360    int save_iiOp=iiOp;
1361    if (iiOp==NOTEQUAL)
1362      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1363    else
1364      iiExprArith2(res,u->next,iiOp,v->next);
1365    iiOp=save_iiOp;
1366  }
1367  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1368}
1369static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1370{
1371  res->data = (char *)((long)u->Data() && (long)v->Data());
1372  return FALSE;
1373}
1374static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1375{
1376  res->data = (char *)((long)u->Data() || (long)v->Data());
1377  return FALSE;
1378}
1379static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1380{
1381  res->rtyp=u->rtyp; u->rtyp=0;
1382  res->data=u->data; u->data=NULL;
1383  res->name=u->name; u->name=NULL;
1384  res->e=u->e;       u->e=NULL;
1385  if (res->e==NULL) res->e=jjMakeSub(v);
1386  else
1387  {
1388    Subexpr sh=res->e;
1389    while (sh->next != NULL) sh=sh->next;
1390    sh->next=jjMakeSub(v);
1391  }
1392  if (u->next!=NULL)
1393  {
1394    leftv rn=(leftv)omAlloc0Bin(sleftv_bin);
1395    BOOLEAN bo=iiExprArith2(rn,u->next,iiOp,v);
1396    res->next=rn;
1397    return bo;
1398  }
1399  return FALSE;
1400}
1401static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1402{
1403  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1404  {
1405    WerrorS("indexed object must have a name");
1406    return TRUE;
1407  }
1408  intvec * iv=(intvec *)v->Data();
1409  leftv p=NULL;
1410  int i;
1411  sleftv t;
1412  memset(&t,0,sizeof(t));
1413  t.rtyp=INT_CMD;
1414  for (i=0;i<iv->length(); i++)
1415  {
1416    t.data=(char *)((long)(*iv)[i]);
1417    if (p==NULL)
1418    {
1419      p=res;
1420    }
1421    else
1422    {
1423      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1424      p=p->next;
1425    }
1426    p->rtyp=IDHDL;
1427    p->data=u->data;
1428    p->name=u->name;
1429    p->flag=u->flag;
1430    p->e=jjMakeSub(&t);
1431  }
1432  u->rtyp=0;
1433  u->data=NULL;
1434  u->name=NULL;
1435  return FALSE;
1436}
1437static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1438{
1439  poly p=(poly)u->Data();
1440  int i=(int)(long)v->Data();
1441  int j=0;
1442  while (p!=NULL)
1443  {
1444    j++;
1445    if (j==i)
1446    {
1447      res->data=(char *)pHead(p);
1448      return FALSE;
1449    }
1450    pIter(p);
1451  }
1452  return FALSE;
1453}
1454static BOOLEAN jjINDEX_PBu(leftv res, leftv u, leftv v)
1455{
1456  sBucket_pt b=(sBucket_pt)u->CopyD();
1457  sBucketCanonicalize(b);
1458  int l; poly p,pp;
1459  sBucketDestroyAdd(b, &pp, &l);
1460  int i=(int)(long)v->Data();
1461  int j=0;
1462  p=pp;
1463  while (p!=NULL)
1464  {
1465    j++;
1466    if (j==i)
1467    {
1468      res->data=(char *)pHead(p);
1469      p_Delete(&pp,currRing);
1470      return FALSE;
1471    }
1472    pIter(p);
1473  }
1474  p_Delete(&pp,currRing);
1475  return FALSE;
1476}
1477static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1478{
1479  poly p=(poly)u->Data();
1480  poly r=NULL;
1481  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1482  int i;
1483  int sum=0;
1484  for(i=iv->length()-1;i>=0;i--)
1485    sum+=(*iv)[i];
1486  int j=0;
1487  while ((p!=NULL) && (sum>0))
1488  {
1489    j++;
1490    for(i=iv->length()-1;i>=0;i--)
1491    {
1492      if (j==(*iv)[i])
1493      {
1494        r=pAdd(r,pHead(p));
1495        sum-=j;
1496        (*iv)[i]=0;
1497        break;
1498      }
1499    }
1500    pIter(p);
1501  }
1502  delete iv;
1503  res->data=(char *)r;
1504  return FALSE;
1505}
1506static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1507{
1508  poly p=(poly)u->Data();
1509  int i=(int)(long)v->Data();
1510  res->data=(char *)p_Vec2Poly(p,i,currRing);
1511  return FALSE;
1512}
1513static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1514{
1515  poly p=(poly)u->CopyD(VECTOR_CMD);
1516  if (p!=NULL)
1517  {
1518    poly r=pOne();
1519    poly hp=r;
1520    intvec *iv=(intvec *)v->Data();
1521    int i;
1522    loop
1523    {
1524      for(i=0;i<iv->length();i++)
1525      {
1526        if (((int)pGetComp(p))==(*iv)[i])
1527        {
1528          poly h;
1529          pSplit(p,&h);
1530          pNext(hp)=p;
1531          p=h;
1532          pIter(hp);
1533          break;
1534        }
1535      }
1536      if (p==NULL) break;
1537      if (i==iv->length())
1538      {
1539        pLmDelete(&p);
1540        if (p==NULL) break;
1541      }
1542    }
1543    pLmDelete(&r);
1544    res->data=(char *)r;
1545  }
1546  return FALSE;
1547}
1548static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1549static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1550{
1551  if(u->name==NULL) return TRUE;
1552  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1553  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1554  omFree((ADDRESS)u->name);
1555  u->name=NULL;
1556  char *n=omStrDup(nn);
1557  omFree((ADDRESS)nn);
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  intvec * iv=(intvec *)v->Data();
1565  leftv p=NULL;
1566  int i;
1567  long slen = strlen(u->name) + 14;
1568  char *n = (char*) omAlloc(slen);
1569
1570  for (i=0;i<iv->length(); i++)
1571  {
1572    if (p==NULL)
1573    {
1574      p=res;
1575    }
1576    else
1577    {
1578      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1579      p=p->next;
1580    }
1581    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1582    syMake(p,omStrDup(n));
1583  }
1584  omFree((ADDRESS)u->name);
1585  u->name = NULL;
1586  omFreeSize(n, slen);
1587  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1588  return FALSE;
1589}
1590static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1591{
1592  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1593  memset(tmp,0,sizeof(sleftv));
1594  BOOLEAN b;
1595  if (v->Typ()==INTVEC_CMD)
1596    b=jjKLAMMER_IV(tmp,u,v);
1597  else
1598    b=jjKLAMMER(tmp,u,v);
1599  if (b)
1600  {
1601    omFreeBin(tmp,sleftv_bin);
1602    return TRUE;
1603  }
1604  leftv h=res;
1605  while (h->next!=NULL) h=h->next;
1606  h->next=tmp;
1607  return FALSE;
1608}
1609BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1610{
1611  void *d;
1612  Subexpr e;
1613  int typ;
1614  BOOLEAN t=FALSE;
1615  idhdl tmp_proc=NULL;
1616  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1617  {
1618    tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1619    tmp_proc->id="_auto";
1620    tmp_proc->typ=PROC_CMD;
1621    tmp_proc->data.pinf=(procinfo *)u->Data();
1622    tmp_proc->ref=1;
1623    d=u->data; u->data=(void *)tmp_proc;
1624    e=u->e; u->e=NULL;
1625    t=TRUE;
1626    typ=u->rtyp; u->rtyp=IDHDL;
1627  }
1628  BOOLEAN sl;
1629  if (u->req_packhdl==currPack)
1630    sl = iiMake_proc((idhdl)u->data,NULL,v);
1631  else
1632    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1633  if (t)
1634  {
1635    u->rtyp=typ;
1636    u->data=d;
1637    u->e=e;
1638    omFreeSize(tmp_proc,sizeof(idrec));
1639  }
1640  if (sl) return TRUE;
1641  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1642  iiRETURNEXPR.Init();
1643  return FALSE;
1644}
1645static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1646{
1647  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1648  leftv sl=NULL;
1649  if ((v->e==NULL)&&(v->name!=NULL))
1650  {
1651    map m=(map)u->Data();
1652    sl=iiMap(m,v->name);
1653  }
1654  else
1655  {
1656    Werror("%s(<name>) expected",u->Name());
1657  }
1658  if (sl==NULL) return TRUE;
1659  memcpy(res,sl,sizeof(sleftv));
1660  omFreeBin((ADDRESS)sl, sleftv_bin);
1661  return FALSE;
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  memset(v,0,sizeof(sleftv));
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  short *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(short) );
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    short *iv=iv2array((intvec *)v->Data(),currRing);
1844    const long d = p_DegW(p,iv,currRing);
1845    omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
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#ifdef HAVE_RINGS
1915  if (rField_is_Ring(currRing))
1916  {
1917    ideal vid = (ideal)v->Data();
1918    int i = idPosConstant(vid);
1919    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1920    { /* ideal v contains unit; dim = -1 */
1921      res->data = (char *)-1;
1922      return FALSE;
1923    }
1924    ideal vv = id_Copy(vid, currRing);
1925    ideal ww = id_Copy((ideal)w->Data(), currRing);
1926    /* drop degree zero generator from vv (if any) */
1927    if (i != -1) pDelete(&vv->m[i]);
1928    long d = (long)scDimInt(vv, ww);
1929    if (rField_is_Z(currRing) && (i == -1)) d++;
1930    res->data = (char *)d;
1931    idDelete(&vv); idDelete(&ww);
1932    return FALSE;
1933  }
1934#endif
1935  if(currRing->qideal==NULL)
1936    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1937  else
1938  {
1939    ideal q=idSimpleAdd(currRing->qideal,(ideal)w->Data());
1940    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1941    idDelete(&q);
1942  }
1943  return FALSE;
1944}
1945static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1946{
1947  ideal vi=(ideal)v->Data();
1948  int vl= IDELEMS(vi);
1949  ideal ui=(ideal)u->Data();
1950  unsigned ul= IDELEMS(ui);
1951  ideal R; matrix U;
1952  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1953  if (m==NULL) return TRUE;
1954  // now make sure that all matrices have the corect size:
1955  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
1956  int i;
1957  if (MATCOLS(U) != (int)ul)
1958  {
1959    unsigned mul=si_min(ul,MATCOLS(U));
1960    matrix UU=mpNew(ul,ul);
1961    unsigned j;
1962    for(i=mul;i>0;i--)
1963    {
1964      for(j=mul;j>0;j--)
1965      {
1966        MATELEM(UU,i,j)=MATELEM(U,i,j);
1967        MATELEM(U,i,j)=NULL;
1968      }
1969    }
1970    idDelete((ideal *)&U);
1971    U=UU;
1972  }
1973  // make sure that U is a diagonal matrix of units
1974  for(i=ul;i>0;i--)
1975  {
1976    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1977  }
1978  lists L=(lists)omAllocBin(slists_bin);
1979  L->Init(3);
1980  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1981  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1982  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1983  res->data=(char *)L;
1984  return FALSE;
1985}
1986static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1987{
1988  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1989  //setFlag(res,FLAG_STD);
1990  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
1991}
1992static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1993{
1994  poly p=pOne();
1995  intvec *iv=(intvec*)v->Data();
1996  for(int i=iv->length()-1; i>=0; i--)
1997  {
1998    pSetExp(p,(*iv)[i],1);
1999  }
2000  pSetm(p);
2001  res->data=(char *)idElimination((ideal)u->Data(),p);
2002  pLmDelete(&p);
2003  //setFlag(res,FLAG_STD);
2004  return FALSE;
2005}
2006static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
2007{
2008  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
2009  return iiExport(v,0,IDPACKAGE((idhdl)u->data));
2010}
2011static BOOLEAN jjERROR(leftv, leftv u)
2012{
2013  WerrorS((char *)u->Data());
2014  EXTERN_VAR int inerror;
2015  inerror=3;
2016  return TRUE;
2017}
2018static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
2019{
2020  number uu=(number)u->Data();number vv=(number)v->Data();
2021  lists L=(lists)omAllocBin(slists_bin);
2022  number a,b;
2023  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
2024  L->Init(3);
2025  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
2026  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
2027  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
2028  res->rtyp=LIST_CMD;
2029  res->data=(char *)L;
2030  return FALSE;
2031}
2032static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
2033{
2034  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2035  int p0=ABS(uu),p1=ABS(vv);
2036  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2037
2038  while ( p1!=0 )
2039  {
2040    q=p0 / p1;
2041    r=p0 % p1;
2042    p0 = p1; p1 = r;
2043    r = g0 - g1 * q;
2044    g0 = g1; g1 = r;
2045    r = f0 - f1 * q;
2046    f0 = f1; f1 = r;
2047  }
2048  int a = f0;
2049  int b = g0;
2050  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2051  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2052  lists L=(lists)omAllocBin(slists_bin);
2053  L->Init(3);
2054  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2055  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2056  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2057  res->rtyp=LIST_CMD;
2058  res->data=(char *)L;
2059  return FALSE;
2060}
2061static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2062{
2063  poly r,pa,pb;
2064  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2065  if (ret) return TRUE;
2066  lists L=(lists)omAllocBin(slists_bin);
2067  L->Init(3);
2068  res->data=(char *)L;
2069  L->m[0].data=(void *)r;
2070  L->m[0].rtyp=POLY_CMD;
2071  L->m[1].data=(void *)pa;
2072  L->m[1].rtyp=POLY_CMD;
2073  L->m[2].data=(void *)pb;
2074  L->m[2].rtyp=POLY_CMD;
2075  return FALSE;
2076}
2077EXTERN_VAR int singclap_factorize_retry;
2078static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2079{
2080  intvec *v=NULL;
2081  int sw=(int)(long)dummy->Data();
2082  int fac_sw=sw;
2083  if ((sw<0)||(sw>2)) fac_sw=1;
2084  singclap_factorize_retry=0;
2085  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2086  if (f==NULL)
2087    return TRUE;
2088  switch(sw)
2089  {
2090    case 0:
2091    case 2:
2092    {
2093      lists l=(lists)omAllocBin(slists_bin);
2094      l->Init(2);
2095      l->m[0].rtyp=IDEAL_CMD;
2096      l->m[0].data=(void *)f;
2097      l->m[1].rtyp=INTVEC_CMD;
2098      l->m[1].data=(void *)v;
2099      res->data=(void *)l;
2100      res->rtyp=LIST_CMD;
2101      return FALSE;
2102    }
2103    case 1:
2104      res->data=(void *)f;
2105      return FALSE;
2106    case 3:
2107      {
2108        poly p=f->m[0];
2109        int i=IDELEMS(f);
2110        f->m[0]=NULL;
2111        while(i>1)
2112        {
2113          i--;
2114          p=pMult(p,f->m[i]);
2115          f->m[i]=NULL;
2116        }
2117        res->data=(void *)p;
2118        res->rtyp=POLY_CMD;
2119      }
2120      return FALSE;
2121  }
2122  WerrorS("invalid switch");
2123  return TRUE;
2124}
2125static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2126{
2127  ideal_list p,h;
2128  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2129  p=h;
2130  int l=0;
2131  while (p!=NULL) { p=p->next;l++; }
2132  lists L=(lists)omAllocBin(slists_bin);
2133  L->Init(l);
2134  l=0;
2135  while(h!=NULL)
2136  {
2137    L->m[l].data=(char *)h->d;
2138    L->m[l].rtyp=IDEAL_CMD;
2139    p=h->next;
2140    omFreeSize(h,sizeof(*h));
2141    h=p;
2142    l++;
2143  }
2144  res->data=(void *)L;
2145  return FALSE;
2146}
2147static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2148{
2149  if (rField_is_Q(currRing))
2150  {
2151    number uu=(number)u->Data();
2152    number vv=(number)v->Data();
2153    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2154    return FALSE;
2155  }
2156  else return TRUE;
2157}
2158static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2159{
2160  ideal uu=(ideal)u->Data();
2161  number vv=(number)v->Data();
2162  //timespec buf1,buf2;
2163  //clock_gettime(CLOCK_THREAD_CPUTIME_ID,&buf1);
2164  res->data=(void*)id_Farey(uu,vv,currRing);
2165  //clock_gettime(CLOCK_THREAD_CPUTIME_ID,&buf2);
2166  //const unsigned long SEC = 1000L*1000L*1000L;
2167  //all_farey+=((buf2.tv_sec-buf1.tv_sec)*SEC+
2168  //                              buf2.tv_nsec-buf1.tv_nsec);
2169  //farey_cnt++;
2170  return FALSE;
2171}
2172static BOOLEAN jjFAREY_LI(leftv res, leftv u, leftv v);
2173static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2174{
2175  ring r=(ring)u->Data();
2176  idhdl w;
2177  int op=iiOp;
2178  nMapFunc nMap;
2179
2180  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2181  {
2182    int *perm=NULL;
2183    int *par_perm=NULL;
2184    int par_perm_size=0;
2185    BOOLEAN bo;
2186    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2187    {
2188      // Allow imap/fetch to be make an exception only for:
2189      if (nCoeff_is_Extension(r->cf) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2190         ((n_SetMap(r->cf->extRing->cf,currRing->cf)!=NULL)
2191         || (nCoeff_is_Extension(currRing->cf) && (n_SetMap(r->cf->extRing->cf,currRing->cf->extRing->cf)!=NULL))))
2192      {
2193        par_perm_size=rPar(r);
2194      }
2195      else
2196      {
2197        goto err_fetch;
2198      }
2199    }
2200    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2201    {
2202      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2203      if (par_perm_size!=0)
2204        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2205      op=IMAP_CMD;
2206      if (iiOp==IMAP_CMD)
2207      {
2208        int r_par=0;
2209        char ** r_par_names=NULL;
2210        if (r->cf->extRing!=NULL)
2211        {
2212          r_par=r->cf->extRing->N;
2213          r_par_names=r->cf->extRing->names;
2214        }
2215        int c_par=0;
2216        char ** c_par_names=NULL;
2217        if (currRing->cf->extRing!=NULL)
2218        {
2219          c_par=currRing->cf->extRing->N;
2220          c_par_names=currRing->cf->extRing->names;
2221        }
2222        if (!rIsLPRing(r))
2223        {
2224          maFindPerm(r->names,       r->N,       r_par_names, r_par,
2225                     currRing->names,currRing->N,c_par_names, c_par,
2226                     perm,par_perm, currRing->cf->type);
2227        }
2228        #ifdef HAVE_SHIFTBBA
2229        else
2230        {
2231          maFindPermLP(r->names,       r->N,       r_par_names, r_par,
2232                     currRing->names,currRing->N,c_par_names, c_par,
2233                     perm,par_perm, currRing->cf->type,r->isLPring);
2234        }
2235        #endif
2236      }
2237      else
2238      {
2239        unsigned i;
2240        if (par_perm_size!=0)
2241          for(i=si_min(rPar(r),rPar(currRing));i>0;i--) par_perm[i-1]=-i;
2242        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2243      }
2244    }
2245    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2246    {
2247      unsigned i;
2248      for(i=0;i<(unsigned)si_min(r->N,currRing->N);i++)
2249      {
2250        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2251      }
2252      for(i=0;i<(unsigned)si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2253      {
2254        Print("// par nr %d: %s -> %s\n",
2255              i,rParameter(r)[i],rParameter(currRing)[i]);
2256      }
2257    }
2258    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
2259    sleftv tmpW;
2260    memset(&tmpW,0,sizeof(sleftv));
2261    tmpW.rtyp=IDTYP(w);
2262    tmpW.data=IDDATA(w);
2263    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2264                         perm,par_perm,par_perm_size,nMap)))
2265    {
2266      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2267    }
2268    if (perm!=NULL)
2269      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2270    if (par_perm!=NULL)
2271      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2272    return bo;
2273  }
2274  else
2275  {
2276    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2277  }
2278  return TRUE;
2279err_fetch:
2280  char *s1=nCoeffString(r->cf);
2281  char *s2=nCoeffString(currRing->cf);
2282  Werror("no identity map from %s (%s -> %s)",u->Fullname(),s1,s2);
2283  omFree(s2); omFree(s1);
2284  return TRUE;
2285}
2286static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2287{
2288  /*4
2289  * look for the substring what in the string where
2290  * return the position of the first char of what in where
2291  * or 0
2292  */
2293  char *where=(char *)u->Data();
2294  char *what=(char *)v->Data();
2295  char *found = strstr(where,what);
2296  if (found != NULL)
2297  {
2298    res->data=(char *)((found-where)+1);
2299  }
2300  /*else res->data=NULL;*/
2301  return FALSE;
2302}
2303
2304static BOOLEAN jjFRES3(leftv res, leftv u, leftv v, leftv w)
2305{
2306  assumeStdFlag(u);
2307  ideal id = (ideal)u->Data();
2308  int max_length = (int)(long)v->Data();
2309  if (max_length < 0)
2310  {
2311    WerrorS("length for fres must not be negative");
2312    return TRUE;
2313  }
2314  if (max_length == 0)
2315  {
2316    max_length = currRing->N+1;
2317    if (currRing->qideal != NULL)
2318    {
2319      Warn("full resolution in a qring may be infinite, "
2320           "setting max length to %d", max_length);
2321    }
2322  }
2323  char *method = (char *)w->Data();
2324  /* For the moment, only "complete" (default), "frame", or "extended frame"
2325   * are allowed. Another useful option would be "linear strand".
2326   */
2327  if (strcmp(method, "complete") != 0
2328  && strcmp(method, "frame") != 0
2329  && strcmp(method, "extended frame") != 0
2330  && strcmp(method, "single module") != 0)
2331  {
2332    WerrorS("wrong optional argument for fres");
2333    return TRUE;
2334  }
2335  syStrategy r = syFrank(id, max_length, method);
2336  assume(r->fullres != NULL);
2337  res->data = (void *)r;
2338  return FALSE;
2339}
2340
2341static BOOLEAN jjFRES(leftv res, leftv u, leftv v)
2342{
2343    leftv w = (leftv)omAlloc0(sizeof(sleftv));
2344    w->rtyp = STRING_CMD;
2345    w->data = (char *)"complete";   // default
2346    BOOLEAN RES = jjFRES3(res, u, v, w);
2347    omFree(w);
2348    return RES;
2349}
2350
2351static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2352{
2353  res->data=(char *)fractalWalkProc(u,v);
2354  setFlag( res, FLAG_STD );
2355  return FALSE;
2356}
2357static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2358{
2359  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2360  int p0=ABS(uu),p1=ABS(vv);
2361  int r;
2362  while ( p1!=0 )
2363  {
2364    r=p0 % p1;
2365    p0 = p1; p1 = r;
2366  }
2367  res->rtyp=INT_CMD;
2368  res->data=(char *)(long)p0;
2369  return FALSE;
2370}
2371static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2372{
2373  number n1 = (number) u->Data();
2374  number n2 = (number) v->Data();
2375  res->data = n_Gcd(n1,n2,coeffs_BIGINT);
2376  return FALSE;
2377}
2378static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2379{
2380  number a=(number) u->Data();
2381  number b=(number) v->Data();
2382  if (nIsZero(a))
2383  {
2384    if (nIsZero(b)) res->data=(char *)nInit(1);
2385    else            res->data=(char *)nCopy(b);
2386  }
2387  else
2388  {
2389    if (nIsZero(b))  res->data=(char *)nCopy(a);
2390    //else res->data=(char *)n_Gcd(a, b, currRing->cf);
2391    else res->data=(char *)n_SubringGcd(a, b, currRing->cf);
2392  }
2393  return FALSE;
2394}
2395static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2396{
2397  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2398                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2399  return FALSE;
2400}
2401static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2402{
2403#ifdef HAVE_RINGS
2404  if (rField_is_Z(currRing))
2405  {
2406    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
2407    PrintS("//       performed for generic fibre, that is, over Q\n");
2408  }
2409#endif
2410  assumeStdFlag(u);
2411  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2412  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal);
2413  if (errorreported) return TRUE;
2414
2415  switch((int)(long)v->Data())
2416  {
2417    case 1:
2418      res->data=(void *)iv;
2419      return FALSE;
2420    case 2:
2421      res->data=(void *)hSecondSeries(iv);
2422      delete iv;
2423      return FALSE;
2424  }
2425  delete iv;
2426  WerrorS(feNotImplemented);
2427  return TRUE;
2428}
2429static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2430{
2431  int i=pVar((poly)v->Data());
2432  if (i==0)
2433  {
2434    WerrorS("ringvar expected");
2435    return TRUE;
2436  }
2437  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2438  int d=pWTotaldegree(p);
2439  pLmDelete(p);
2440  if (d==1)
2441    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2442  else
2443    WerrorS("variable must have weight 1");
2444  return (d!=1);
2445}
2446static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2447{
2448  int i=pVar((poly)v->Data());
2449  if (i==0)
2450  {
2451    WerrorS("ringvar expected");
2452    return TRUE;
2453  }
2454  pFDegProc deg;
2455  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2456    deg=p_Totaldegree;
2457   else
2458    deg=currRing->pFDeg;
2459  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2460  int d=deg(p,currRing);
2461  pLmDelete(p);
2462  if (d==1)
2463    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2464  else
2465    WerrorS("variable must have weight 1");
2466  return (d!=1);
2467}
2468static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2469{
2470  intvec *w=new intvec(rVar(currRing));
2471  intvec *vw=(intvec*)u->Data();
2472  ideal v_id=(ideal)v->Data();
2473  pFDegProc save_FDeg=currRing->pFDeg;
2474  pLDegProc save_LDeg=currRing->pLDeg;
2475  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2476  currRing->pLexOrder=FALSE;
2477  kHomW=vw;
2478  kModW=w;
2479  pSetDegProcs(currRing,kHomModDeg);
2480  res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
2481  currRing->pLexOrder=save_pLexOrder;
2482  kHomW=NULL;
2483  kModW=NULL;
2484  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2485  if (w!=NULL) delete w;
2486  return FALSE;
2487}
2488static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2489{
2490  assumeStdFlag(u);
2491  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2492                    currRing->qideal);
2493  return FALSE;
2494}
2495static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2496{
2497  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2498  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2499  return FALSE;
2500}
2501static BOOLEAN jjINTERPOLATION (leftv res, leftv l, leftv v)
2502{
2503  const lists L = (lists)l->Data();
2504  const int n = L->nr; assume (n >= 0);
2505  std::vector<ideal> V(n + 1);
2506
2507  for(int i = n; i >= 0; i--) V[i] = (ideal)(L->m[i].Data());
2508
2509  res->data=interpolation(V, (intvec*)v->Data());
2510  setFlag(res,FLAG_STD);
2511  return errorreported;
2512}
2513static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2514{
2515  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2516  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2517}
2518
2519static BOOLEAN jjJanetBasis(leftv res, leftv v)
2520{
2521  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2522  return jjStdJanetBasis(res,v,0);
2523}
2524static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2525{
2526  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2527  return FALSE;
2528}
2529static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2530{
2531  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2532  return FALSE;
2533}
2534static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2535{
2536  assumeStdFlag(u);
2537  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2538  res->data = (char *)scKBase((int)(long)v->Data(),
2539                              (ideal)(u->Data()),currRing->qideal, w_u);
2540  if (w_u!=NULL)
2541  {
2542    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2543  }
2544  return FALSE;
2545}
2546static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2547static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2548{
2549  return jjPREIMAGE(res,u,v,NULL);
2550}
2551static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2552{
2553  return mpKoszul(res, u,v,NULL);
2554}
2555static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2556{
2557  sleftv h;
2558  memset(&h,0,sizeof(sleftv));
2559  h.rtyp=INT_CMD;
2560  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2561  return mpKoszul(res, u, &h, v);
2562}
2563static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2564{
2565  int ul= IDELEMS((ideal)u->Data());
2566  int vl= IDELEMS((ideal)v->Data());
2567  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2568                   hasFlag(u,FLAG_STD));
2569  if (m==NULL) return TRUE;
2570  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2571  return FALSE;
2572}
2573static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2574{
2575  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2576  idhdl h=(idhdl)v->data;
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  id_DelMultiples((ideal)(res->data),currRing);
3018  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
3019  return FALSE;
3020}
3021static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
3022{
3023  int i=(int)(long)u->Data();
3024  int j=(int)(long)v->Data();
3025  if (j-i <0) {WerrorS("invalid range for random"); return TRUE;}
3026  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
3027  return FALSE;
3028}
3029static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
3030{
3031  matrix m =(matrix)u->Data();
3032  int isRowEchelon = (int)(long)v->Data();
3033  if (isRowEchelon != 1) isRowEchelon = 0;
3034  int rank = luRank(m, isRowEchelon);
3035  res->data =(char *)(long)rank;
3036  return FALSE;
3037}
3038static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
3039{
3040  si_link l=(si_link)u->Data();
3041  leftv r=slRead(l,v);
3042  if (r==NULL)
3043  {
3044    const char *s;
3045    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3046    else                            s=sNoName_fe;
3047    Werror("cannot read from `%s`",s);
3048    return TRUE;
3049  }
3050  memcpy(res,r,sizeof(sleftv));
3051  omFreeBin((ADDRESS)r, sleftv_bin);
3052  return FALSE;
3053}
3054static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
3055{
3056  ideal vi=(ideal)v->Data();
3057  if (currRing->qideal!=NULL || vi->ncols>1 || rIsPluralRing(currRing))
3058    assumeStdFlag(v);
3059  res->data = (char *)kNF(vi,currRing->qideal,(poly)u->Data());
3060  return FALSE;
3061}
3062static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
3063{
3064  ideal ui=(ideal)u->Data();
3065  ideal vi=(ideal)v->Data();
3066  if (currRing->qideal!=NULL || vi->ncols>1 || rIsPluralRing(currRing))
3067    assumeStdFlag(v);
3068  res->data = (char *)kNF(vi,currRing->qideal,ui);
3069  return FALSE;
3070}
3071static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3072{
3073  int maxl=(int)(long)v->Data();
3074  if (maxl<0)
3075  {
3076    WerrorS("length for res must not be negative");
3077    return TRUE;
3078  }
3079  syStrategy r;
3080  intvec *weights=NULL;
3081  int wmaxl=maxl;
3082  ideal u_id=(ideal)u->Data();
3083
3084  maxl--;
3085  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3086  {
3087    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3088    if (currRing->qideal!=NULL)
3089    {
3090      Warn(
3091      "full resolution in a qring may be infinite, setting max length to %d",
3092      maxl+1);
3093    }
3094  }
3095  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3096  if (weights!=NULL)
3097  {
3098    if (!idTestHomModule(u_id,currRing->qideal,weights))
3099    {
3100      WarnS("wrong weights given:");weights->show();PrintLn();
3101      weights=NULL;
3102    }
3103  }
3104  intvec *ww=NULL;
3105  int add_row_shift=0;
3106  if (weights!=NULL)
3107  {
3108     ww=ivCopy(weights);
3109     add_row_shift = ww->min_in();
3110     (*ww) -= add_row_shift;
3111  }
3112  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3113  {
3114    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3115  }
3116  else if (iiOp==SRES_CMD)
3117  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3118    r=sySchreyer(u_id,maxl+1);
3119  else if (iiOp == LRES_CMD)
3120  {
3121    int dummy;
3122    if((currRing->qideal!=NULL)||
3123    (!idHomIdeal (u_id,NULL)))
3124    {
3125       WerrorS
3126       ("`lres` not implemented for inhomogeneous input or qring");
3127       return TRUE;
3128    }
3129    if(currRing->N == 1)
3130      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3131    r=syLaScala3(u_id,&dummy);
3132  }
3133  else if (iiOp == KRES_CMD)
3134  {
3135    int dummy;
3136    if((currRing->qideal!=NULL)||
3137    (!idHomIdeal (u_id,NULL)))
3138    {
3139       WerrorS
3140       ("`kres` not implemented for inhomogeneous input or qring");
3141       return TRUE;
3142    }
3143    r=syKosz(u_id,&dummy);
3144  }
3145  else
3146  {
3147    int dummy;
3148    if((currRing->qideal!=NULL)||
3149    (!idHomIdeal (u_id,NULL)))
3150    {
3151       WerrorS
3152       ("`hres` not implemented for inhomogeneous input or qring");
3153       return TRUE;
3154    }
3155    ideal u_id_copy=idCopy(u_id);
3156    idSkipZeroes(u_id_copy);
3157    r=syHilb(u_id_copy,&dummy);
3158    idDelete(&u_id_copy);
3159  }
3160  if (r==NULL) return TRUE;
3161  if (r->list_length>wmaxl)
3162  {
3163    for(int i=wmaxl-1;i>=r->list_length;i--)
3164    {
3165      if (r->fullres[i]!=NULL) id_Delete(&r->fullres[i],currRing);
3166      if (r->minres[i]!=NULL) id_Delete(&r->minres[i],currRing);
3167    }
3168  }
3169  r->list_length=wmaxl;
3170  res->data=(void *)r;
3171  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3172  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3173  {
3174    ww=ivCopy(r->weights[0]);
3175    if (weights!=NULL) (*ww) += add_row_shift;
3176    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3177  }
3178  else
3179  {
3180    if (weights!=NULL)
3181    {
3182      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3183    }
3184  }
3185
3186  // test the La Scala case' output
3187  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3188  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3189
3190  if(iiOp != HRES_CMD)
3191    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3192  else
3193    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3194
3195  return FALSE;
3196}
3197static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3198{
3199  number n1; int i;
3200
3201  if ((u->Typ() == BIGINT_CMD) ||
3202     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3203  {
3204    n1 = (number)u->CopyD();
3205  }
3206  else if (u->Typ() == INT_CMD)
3207  {
3208    i = (int)(long)u->Data();
3209    n1 = n_Init(i, coeffs_BIGINT);
3210  }
3211  else
3212  {
3213    return TRUE;
3214  }
3215
3216  i = (int)(long)v->Data();
3217
3218  lists l = primeFactorisation(n1, i);
3219  n_Delete(&n1, coeffs_BIGINT);
3220  res->data = (char*)l;
3221  return FALSE;
3222}
3223static BOOLEAN jjRMINUS(leftv res, leftv u, leftv v)
3224{
3225  ring r=rMinusVar((ring)u->Data(),(char*)v->Data());
3226  res->data = (char *)r;
3227  return r==NULL;
3228}
3229static BOOLEAN jjRPLUS(leftv res, leftv u, leftv v)
3230{
3231  int left;
3232  if (u->Typ()==RING_CMD) left=0;
3233  else
3234  {
3235    leftv h=u;u=v;v=h;
3236    left=1;
3237  }
3238  ring r=rPlusVar((ring)u->Data(),(char*)v->Data(),left);
3239  res->data = (char *)r;
3240  return r==NULL;
3241}
3242static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3243{
3244  ring r;
3245  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3246  res->data = (char *)r;
3247  return (i==-1);
3248}
3249#define SIMPL_NORMALIZE 64
3250#define SIMPL_LMDIV 32
3251#define SIMPL_LMEQ  16
3252#define SIMPL_MULT 8
3253#define SIMPL_EQU  4
3254#define SIMPL_NULL 2
3255#define SIMPL_NORM 1
3256static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3257{
3258  int sw = (int)(long)v->Data();
3259  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3260  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3261  if (sw & SIMPL_LMDIV)
3262  {
3263    id_DelDiv(id,currRing);
3264  }
3265  if (sw & SIMPL_LMEQ)
3266  {
3267    id_DelLmEquals(id,currRing);
3268  }
3269  if (sw & SIMPL_MULT)
3270  {
3271    id_DelMultiples(id,currRing);
3272  }
3273  else if(sw & SIMPL_EQU)
3274  {
3275    id_DelEquals(id,currRing);
3276  }
3277  if (sw & SIMPL_NULL)
3278  {
3279    idSkipZeroes(id);
3280  }
3281  if (sw & SIMPL_NORM)
3282  {
3283    id_Norm(id,currRing);
3284  }
3285  if (sw & SIMPL_NORMALIZE)
3286  {
3287    id_Normalize(id,currRing);
3288  }
3289  res->data = (char * )id;
3290  return FALSE;
3291}
3292EXTERN_VAR int singclap_factorize_retry;
3293static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3294{
3295  intvec *v=NULL;
3296  int sw=(int)(long)dummy->Data();
3297  int fac_sw=sw;
3298  if (sw<0) fac_sw=1;
3299  singclap_factorize_retry=0;
3300  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3301  if (f==NULL)
3302    return TRUE;
3303  switch(sw)
3304  {
3305    case 0:
3306    case 2:
3307    {
3308      lists l=(lists)omAllocBin(slists_bin);
3309      l->Init(2);
3310      l->m[0].rtyp=IDEAL_CMD;
3311      l->m[0].data=(void *)f;
3312      l->m[1].rtyp=INTVEC_CMD;
3313      l->m[1].data=(void *)v;
3314      res->data=(void *)l;
3315      res->rtyp=LIST_CMD;
3316      return FALSE;
3317    }
3318    case 1:
3319      res->data=(void *)f;
3320      return FALSE;
3321    case 3:
3322      {
3323        poly p=f->m[0];
3324        int i=IDELEMS(f);
3325        f->m[0]=NULL;
3326        while(i>1)
3327        {
3328          i--;
3329          p=pMult(p,f->m[i]);
3330          f->m[i]=NULL;
3331        }
3332        res->data=(void *)p;
3333        res->rtyp=POLY_CMD;
3334      }
3335      return FALSE;
3336  }
3337  WerrorS("invalid switch");
3338  return FALSE;
3339}
3340static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3341{
3342  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3343  return FALSE;
3344}
3345static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3346{
3347  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3348  //return (res->data== (void*)(long)-2);
3349  return FALSE;
3350}
3351static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3352{
3353  int sw = (int)(long)v->Data();
3354  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3355  poly p = (poly)u->CopyD(POLY_CMD);
3356  if (sw & SIMPL_NORM)
3357  {
3358    pNorm(p);
3359  }
3360  if (sw & SIMPL_NORMALIZE)
3361  {
3362    p_Normalize(p,currRing);
3363  }
3364  res->data = (char * )p;
3365  return FALSE;
3366}
3367static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3368{
3369  ideal result;
3370  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3371  tHomog hom=testHomog;
3372  ideal u_id=(ideal)(u->Data());
3373  if (w!=NULL)
3374  {
3375    if (!idTestHomModule(u_id,currRing->qideal,w))
3376    {
3377      WarnS("wrong weights:");w->show();PrintLn();
3378      w=NULL;
3379    }
3380    else
3381    {
3382      w=ivCopy(w);
3383      hom=isHomog;
3384    }
3385  }
3386  result=kStd(u_id,currRing->qideal,hom,&w,(intvec *)v->Data());
3387  idSkipZeroes(result);
3388  res->data = (char *)result;
3389  setFlag(res,FLAG_STD);
3390  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3391  return FALSE;
3392}
3393static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3394{
3395  ideal result;
3396  assumeStdFlag(u);
3397  ideal i1=(ideal)(u->Data());
3398  int ii1=idElem(i1); /* size of i1 */
3399  ideal i0;
3400  int r=v->Typ();
3401  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3402  {
3403    poly p=(poly)v->Data();
3404    i0=idInit(1,i1->rank);
3405    i0->m[0]=p;
3406    i1=idSimpleAdd(i1,i0); //
3407    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3408    idDelete(&i0);
3409    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3410    tHomog hom=testHomog;
3411
3412    if (w!=NULL)
3413    {
3414      if (!idTestHomModule(i1,currRing->qideal,w))
3415      {
3416        // no warnung: this is legal, if i in std(i,p)
3417        // is homogeneous, but p not
3418        w=NULL;
3419      }
3420      else
3421      {
3422        w=ivCopy(w);
3423        hom=isHomog;
3424      }
3425    }
3426    BITSET save1;
3427    SI_SAVE_OPT1(save1);
3428    si_opt_1|=Sy_bit(OPT_SB_1);
3429    /* ii1 appears to be the position of the first element of il that
3430       does not belong to the old SB ideal */
3431    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii1);
3432    SI_RESTORE_OPT1(save1);
3433    idDelete(&i1);
3434    idSkipZeroes(result);
3435    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3436    res->data = (char *)result;
3437  }
3438  else /*IDEAL/MODULE*/
3439  {
3440    i0=(ideal)v->CopyD();
3441    i1=idSimpleAdd(i1,i0); //
3442    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3443    idDelete(&i0);
3444    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3445    tHomog hom=testHomog;
3446
3447    if (w!=NULL)
3448    {
3449      if (!idTestHomModule(i1,currRing->qideal,w))
3450      {
3451        // no warnung: this is legal, if i in std(i,p)
3452        // is homogeneous, but p not
3453        w=NULL;
3454        hom=isNotHomog;
3455      }
3456      else
3457      {
3458        w=ivCopy(w);
3459        hom=isHomog;
3460      }
3461    }
3462    BITSET save1;
3463    SI_SAVE_OPT1(save1);
3464    si_opt_1|=Sy_bit(OPT_SB_1);
3465    /* ii1 appears to be the position of the first element of i1 that
3466     does not belong to the old SB ideal */
3467    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii1);
3468    SI_RESTORE_OPT1(save1);
3469    idDelete(&i1);
3470    idSkipZeroes(result);
3471    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3472    res->data = (char *)result;
3473  }
3474  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3475  return FALSE;
3476}
3477static BOOLEAN jjSYZ_2(leftv res, leftv u, leftv v)
3478{
3479  // see jjSYZYGY
3480  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3481  intvec *w=NULL;
3482  tHomog hom=testHomog;
3483  ideal I=(ideal)u->Data();
3484  GbVariant alg=syGetAlgorithm((char*)v->Data(),currRing,I);
3485  if (ww!=NULL)
3486  {
3487    if (idTestHomModule(I,currRing->qideal,ww))
3488    {
3489      w=ivCopy(ww);
3490      int add_row_shift=w->min_in();
3491      (*w)-=add_row_shift;
3492      hom=isHomog;
3493    }
3494    else
3495    {
3496      //WarnS("wrong weights");
3497      delete ww; ww=NULL;
3498      hom=testHomog;
3499    }
3500  }
3501  else
3502  {
3503    if (u->Typ()==IDEAL_CMD)
3504      if (idHomIdeal(I,currRing->qideal))
3505        hom=isHomog;
3506  }
3507  ideal S=idSyzygies(I,hom,&w,TRUE,FALSE,NULL,alg);
3508  if (w!=NULL) delete w;
3509  res->data = (char *)S;
3510  if (hom==isHomog)
3511  {
3512    int vl=S->rank;
3513    intvec *vv=new intvec(vl);
3514    if ((u->Typ()==IDEAL_CMD)||(ww==NULL))
3515    {
3516      for(int i=0;i<vl;i++)
3517      {
3518        if (I->m[i]!=NULL)
3519          (*vv)[i]=p_Deg(I->m[i],currRing);
3520      }
3521    }
3522    else
3523    {
3524      p_SetModDeg(ww, currRing);
3525      for(int i=0;i<vl;i++)
3526      {
3527        if (I->m[i]!=NULL)
3528          (*vv)[i]=currRing->pFDeg(I->m[i],currRing);
3529      }
3530      p_SetModDeg(NULL, currRing);
3531    }
3532    if (idTestHomModule(S,currRing->qideal,vv))
3533      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
3534    else
3535      delete vv;
3536  }
3537  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
3538  return FALSE;
3539}
3540static BOOLEAN jjTENSOR(leftv res, leftv u, leftv v)
3541{
3542  ideal A=(ideal)u->Data();
3543  ideal B=(ideal)v->Data();
3544  res->data = (char *)sm_Tensor(A,B,currRing);
3545  return FALSE;
3546}
3547static BOOLEAN jjTENSOR_Ma(leftv res, leftv u, leftv v)
3548{
3549  sleftv tmp_u,tmp_v,tmp_res;
3550  int index=iiTestConvert(MATRIX_CMD,SMATRIX_CMD,dConvertTypes);
3551  iiConvert(MATRIX_CMD,SMATRIX_CMD,index,u,&tmp_u,dConvertTypes);
3552  iiConvert(MATRIX_CMD,SMATRIX_CMD,index,v,&tmp_v,dConvertTypes);
3553  tmp_res.Init();
3554  tmp_res.rtyp=SMATRIX_CMD;
3555  BOOLEAN bo=jjTENSOR(&tmp_res,&tmp_u,&tmp_v);
3556  if (!bo)
3557  {
3558    index=iiTestConvert(SMATRIX_CMD,MATRIX_CMD,dConvertTypes);
3559    iiConvert(SMATRIX_CMD,MATRIX_CMD,index,&tmp_res,res,dConvertTypes);
3560  }
3561  tmp_u.CleanUp();
3562  tmp_v.CleanUp();
3563  tmp_res.CleanUp();
3564  return bo;
3565}
3566static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3567{
3568  idhdl h=(idhdl)u->data;
3569  int i=(int)(long)v->Data();
3570  if ((0<i) && (i<=IDRING(h)->N))
3571    res->data=omStrDup(IDRING(h)->names[i-1]);
3572  else
3573  {
3574    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3575    return TRUE;
3576  }
3577  return FALSE;
3578}
3579static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3580{
3581// input: u: a list with links of type
3582//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3583//        v: timeout for select in milliseconds
3584//           or 0 for polling
3585// returns: ERROR (via Werror): timeout negative
3586//           -1: the read state of all links is eof
3587//            0: timeout (or polling): none ready
3588//           i>0: (at least) L[i] is ready
3589  lists Lforks = (lists)u->Data();
3590  int t = (int)(long)v->Data();
3591  if(t < 0)
3592  {
3593    WerrorS("negative timeout"); return TRUE;
3594  }
3595  int i = slStatusSsiL(Lforks, t*1000);
3596  if(i == -2) /* error */
3597  {
3598    return TRUE;
3599  }
3600  res->data = (void*)(long)i;
3601  return FALSE;
3602}
3603static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3604{
3605// input: u: a list with links of type
3606//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3607//        v: timeout for select in milliseconds
3608//           or 0 for polling
3609// returns: ERROR (via Werror): timeout negative
3610//           -1: the read state of all links is eof
3611//           0: timeout (or polling): none ready
3612//           1: all links are ready
3613//              (caution: at least one is ready, but some maybe dead)
3614  lists Lforks = (lists)u->CopyD();
3615  int timeout = 1000*(int)(long)v->Data();
3616  if(timeout < 0)
3617  {
3618    WerrorS("negative timeout"); return TRUE;
3619  }
3620  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3621  int i;
3622  int ret = -1;
3623  for(unsigned nfinished = 0; nfinished < ((unsigned)Lforks->nr)+1; nfinished++)
3624  {
3625    i = slStatusSsiL(Lforks, timeout);
3626    if(i > 0) /* Lforks[i] is ready */
3627    {
3628      ret = 1;
3629      Lforks->m[i-1].CleanUp();
3630      Lforks->m[i-1].rtyp=DEF_CMD;
3631      Lforks->m[i-1].data=NULL;
3632      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3633    }
3634    else /* terminate the for loop */
3635    {
3636      if(i == -2) /* error */
3637      {
3638        return TRUE;
3639      }
3640      if(i == 0) /* timeout */
3641      {
3642        ret = 0;
3643      }
3644      break;
3645    }
3646  }
3647  Lforks->Clean();
3648  res->data = (void*)(long)ret;
3649  return FALSE;
3650}
3651static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3652{
3653  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3654  return FALSE;
3655}
3656#define jjWRONG2 (proc2)jjWRONG
3657#define jjWRONG3 (proc3)jjWRONG
3658static BOOLEAN jjWRONG(leftv, leftv)
3659{
3660  return TRUE;
3661}
3662
3663/*=================== operations with 1 arg.: static proc =================*/
3664/* must be ordered: first operations for chars (infix ops),
3665 * then alphabetically */
3666
3667static BOOLEAN jjDUMMY(leftv res, leftv u)
3668{
3669//  res->data = (char *)u->CopyD();
3670// also copy attributes:
3671  res->Copy(u);
3672  return FALSE;
3673}
3674static BOOLEAN jjNULL(leftv, leftv)
3675{
3676  return FALSE;
3677}
3678//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3679//{
3680//  res->data = (char *)((int)(long)u->Data()+1);
3681//  return FALSE;
3682//}
3683//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3684//{
3685//  res->data = (char *)((int)(long)u->Data()-1);
3686//  return FALSE;
3687//}
3688static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3689{
3690  if (IDTYP((idhdl)u->data)==INT_CMD)
3691  {
3692    int i=IDINT((idhdl)u->data);
3693    if (iiOp==PLUSPLUS) i++;
3694    else                i--;
3695    IDDATA((idhdl)u->data)=(char *)(long)i;
3696    return FALSE;
3697  }
3698  return TRUE;
3699}
3700static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3701{
3702  number n=(number)u->CopyD(BIGINT_CMD);
3703  n=n_InpNeg(n,coeffs_BIGINT);
3704  res->data = (char *)n;
3705  return FALSE;
3706}
3707static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3708{
3709  res->data = (char *)(-(long)u->Data());
3710  return FALSE;
3711}
3712static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3713{
3714  number n=(number)u->CopyD(NUMBER_CMD);
3715  n=nInpNeg(n);
3716  res->data = (char *)n;
3717  return FALSE;
3718}
3719static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3720{
3721  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3722  return FALSE;
3723}
3724static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3725{
3726  poly m1=pISet(-1);
3727  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3728  return FALSE;
3729}
3730static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3731{
3732  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3733  (*iv)*=(-1);
3734  res->data = (char *)iv;
3735  return FALSE;
3736}
3737static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3738{
3739  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3740  (*bim)*=(-1);
3741  res->data = (char *)bim;
3742  return FALSE;
3743}
3744// dummy for python_module.so and similiar
3745static BOOLEAN jjSetRing(leftv, leftv u)
3746{
3747  if (u->rtyp==IDHDL) rSetHdl((idhdl)u->data);
3748  else
3749  {
3750    ring r=(ring)u->Data();
3751    idhdl h=rFindHdl(r,NULL);
3752    if (h==NULL)
3753    {
3754      char name_buffer[100];
3755      STATIC_VAR int ending=1000000;
3756      ending++;
3757      sprintf(name_buffer, "PYTHON_RING_VAR%d",ending);
3758      h=enterid(name_buffer,0,RING_CMD,&IDROOT);
3759      IDRING(h)=r;
3760      r->ref++;
3761    }
3762    rSetHdl(h);
3763  }
3764  return FALSE;
3765}
3766static BOOLEAN jjPROC1(leftv res, leftv u)
3767{
3768  return jjPROC(res,u,NULL);
3769}
3770static BOOLEAN jjBAREISS(leftv res, leftv v)
3771{
3772  //matrix m=(matrix)v->Data();
3773  //lists l=mpBareiss(m,FALSE);
3774  intvec *iv;
3775  ideal m;
3776  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3777  lists l=(lists)omAllocBin(slists_bin);
3778  l->Init(2);
3779  l->m[0].rtyp=MODUL_CMD;
3780  l->m[1].rtyp=INTVEC_CMD;
3781  l->m[0].data=(void *)m;
3782  l->m[1].data=(void *)iv;
3783  res->data = (char *)l;
3784  return FALSE;
3785}
3786//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3787//{
3788//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3789//  ivTriangMat(m);
3790//  res->data = (char *)m;
3791//  return FALSE;
3792//}
3793static BOOLEAN jjBAREISS_BIM(leftv res, leftv v)
3794{
3795  bigintmat *b=(bigintmat*)v->CopyD(BIGINTMAT_CMD);
3796  b->hnf();
3797  res->data=(char*)b;
3798  return FALSE;
3799}
3800static BOOLEAN jjBI2N(leftv res, leftv u)
3801{
3802  BOOLEAN bo=FALSE;
3803  number n=(number)u->CopyD();
3804  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3805  if (nMap!=NULL)
3806    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3807  else
3808  {
3809    Werror("cannot convert bigint to cring %s", nCoeffName(currRing->cf));
3810    bo=TRUE;
3811  }
3812  n_Delete(&n,coeffs_BIGINT);
3813  return bo;
3814}
3815static BOOLEAN jjBI2IM(leftv res, leftv u)
3816{
3817  bigintmat *b=(bigintmat*)u->Data();
3818  res->data=(void *)bim2iv(b);
3819  return FALSE;
3820}
3821static BOOLEAN jjBI2P(leftv res, leftv u)
3822{
3823  sleftv tmp;
3824  BOOLEAN bo=jjBI2N(&tmp,u);
3825  if (!bo)
3826  {
3827    number n=(number) tmp.data;
3828    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3829    else
3830    {
3831      res->data=(void *)pNSet(n);
3832    }
3833  }
3834  return bo;
3835}
3836static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3837{
3838  return iiExprArithM(res,u,iiOp);
3839}
3840static BOOLEAN jjCHAR(leftv res, leftv v)
3841{
3842  res->data = (char *)(long)rChar((ring)v->Data());
3843  return FALSE;
3844}
3845static BOOLEAN jjCOLS(leftv res, leftv v)
3846{
3847  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3848  return FALSE;
3849}
3850static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3851{
3852  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3853  return FALSE;
3854}
3855static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3856{
3857  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3858  return FALSE;
3859}
3860static BOOLEAN jjCONTENT(leftv res, leftv v)
3861{
3862  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3863  poly p=(poly)v->CopyD(POLY_CMD);
3864  if (p!=NULL) p_Cleardenom(p, currRing);
3865  res->data = (char *)p;
3866  return FALSE;
3867}
3868static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3869{
3870  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3871  return FALSE;
3872}
3873static BOOLEAN jjCOUNT_BIM(leftv res, leftv v)
3874{
3875  bigintmat* aa= (bigintmat *)v->Data();
3876  res->data = (char *)(long)(aa->rows()*aa->cols());
3877  return FALSE;
3878}
3879static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3880{
3881  res->data = (char *)(long)nSize((number)v->Data());
3882  return FALSE;
3883}
3884static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3885{
3886  lists l=(lists)v->Data();
3887  res->data = (char *)(long)(lSize(l)+1);
3888  return FALSE;
3889}
3890static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3891{
3892  matrix m=(matrix)v->Data();
3893  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3894  return FALSE;
3895}
3896static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3897{
3898  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3899  return FALSE;
3900}
3901static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3902{
3903  ring r=(ring)v->Data();
3904  int elems=-1;
3905  if (rField_is_Zp(r))      elems=r->cf->ch;
3906  else if (rField_is_GF(r)) elems=r->cf->m_nfCharQ;
3907  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3908  {
3909    extern int ipower ( int b, int n ); /* factory/cf_util */
3910    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3911  }
3912  res->data = (char *)(long)elems;
3913  return FALSE;
3914}
3915static BOOLEAN jjDEG(leftv res, leftv v)
3916{
3917  int dummy;
3918  poly p=(poly)v->Data();
3919  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3920  else res->data=(char *)-1;
3921  return FALSE;
3922}
3923static BOOLEAN jjDEG_M(leftv res, leftv u)
3924{
3925  ideal I=(ideal)u->Data();
3926  int d=-1;
3927  int dummy;
3928  int i;
3929  for(i=IDELEMS(I)-1;i>=0;i--)
3930    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3931  res->data = (char *)(long)d;
3932  return FALSE;
3933}
3934static BOOLEAN jjDEGREE(leftv res, leftv v)
3935{
3936  SPrintStart();
3937#ifdef HAVE_RINGS
3938  if (rField_is_Z(currRing))
3939  {
3940    PrintS("// NOTE: computation of degree is being performed for\n");
3941    PrintS("//       generic fibre, that is, over Q\n");
3942  }
3943#endif
3944  assumeStdFlag(v);
3945  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3946  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3947  char *s=SPrintEnd();
3948  int l=strlen(s)-1;
3949  s[l]='\0';
3950  res->data=(void*)s;
3951  return FALSE;
3952}
3953static BOOLEAN jjDEFINED(leftv res, leftv v)
3954{
3955  if ((v->rtyp==IDHDL)
3956  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3957  {
3958    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3959  }
3960  else if (v->rtyp!=0) res->data=(void *)(-1);
3961  return FALSE;
3962}
3963
3964/// Return the denominator of the input number
3965static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3966{
3967  number n = reinterpret_cast<number>(v->CopyD());
3968  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing->cf));
3969  n_Delete(&n,currRing);
3970  return FALSE;
3971}
3972
3973/// Return the numerator of the input number
3974static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3975{
3976  number n = reinterpret_cast<number>(v->CopyD());
3977  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing->cf));
3978  n_Delete(&n,currRing);
3979  return FALSE;
3980}
3981
3982static BOOLEAN jjDET(leftv res, leftv v)
3983{
3984  matrix m=(matrix)v->Data();
3985  res ->data = mp_Det(m,currRing);
3986  return FALSE;
3987}
3988static BOOLEAN jjDET_BI(leftv res, leftv v)
3989{
3990  bigintmat * m=(bigintmat*)v->Data();
3991  int i,j;
3992  i=m->rows();j=m->cols();
3993  if(i==j)
3994    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3995  else
3996  {
3997    Werror("det of %d x %d bigintmat",i,j);
3998    return TRUE;
3999  }
4000  return FALSE;
4001}
4002#ifdef SINGULAR_4_2
4003static BOOLEAN jjDET_N2(leftv res, leftv v)
4004{
4005  bigintmat * m=(bigintmat*)v->Data();
4006  number2 r=(number2)omAlloc0(sizeof(*r));
4007  int i,j;
4008  i=m->rows();j=m->cols();
4009  if(i==j)
4010  {
4011    r->n=m->det();
4012    r->cf=m->basecoeffs();
4013  }
4014  else
4015  {
4016    omFreeSize(r,sizeof(*r));
4017    Werror("det of %d x %d cmatrix",i,j);
4018    return TRUE;
4019  }
4020  res->data=(void*)r;
4021  return FALSE;
4022}
4023#endif
4024static BOOLEAN jjDET_I(leftv res, leftv v)
4025{
4026  intvec * m=(intvec*)v->Data();
4027  int i,j;
4028  i=m->rows();j=m->cols();
4029  if(i==j)
4030    res->data = (char *)(long)singclap_det_i(m,currRing);
4031  else
4032  {
4033    Werror("det of %d x %d intmat",i,j);
4034    return TRUE;
4035  }
4036  return FALSE;
4037}
4038static BOOLEAN jjDET_S(leftv res, leftv v)
4039{
4040  ideal I=(ideal)v->Data();
4041  res->data=(char*)sm_Det(I,currRing);
4042  return FALSE;
4043}
4044static BOOLEAN jjDIM(leftv res, leftv v)
4045{
4046  assumeStdFlag(v);
4047  if (rHasMixedOrdering(currRing))
4048  {
4049     Warn("dim(%s) may be wrong because the mixed monomial ordering",v->Name());
4050  }
4051#ifdef HAVE_RINGS
4052  if (rField_is_Ring(currRing))
4053  {
4054    ideal vid = (ideal)v->Data();
4055    int i = idPosConstant(vid);
4056    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4057    { /* ideal v contains unit; dim = -1 */
4058      res->data = (char *)-1L;
4059      return FALSE;
4060    }
4061    ideal vv = id_Head(vid,currRing);
4062    idSkipZeroes(vv);
4063    int j = idPosConstant(vv);
4064    long d;
4065    if(j == -1)
4066    {
4067      d = (long)scDimInt(vv, currRing->qideal);
4068      if(rField_is_Z(currRing))
4069        d++;
4070    }
4071    else
4072    {
4073      if(n_IsUnit(pGetCoeff(vv->m[j]),currRing->cf))
4074        d = -1;
4075      else
4076        d = (long)scDimInt(vv, currRing->qideal);
4077    }
4078    //Anne's Idea for std(4,2x) = 0 bug
4079    long dcurr = d;
4080    for(unsigned ii=0;ii<(unsigned)IDELEMS(vv);ii++)
4081    {
4082      if(vv->m[ii] != NULL && !n_IsUnit(pGetCoeff(vv->m[ii]),currRing->cf))
4083      {
4084        ideal vc = idCopy(vv);
4085        poly c = pInit();
4086        pSetCoeff0(c,nCopy(pGetCoeff(vv->m[ii])));
4087        idInsertPoly(vc,c);
4088        idSkipZeroes(vc);
4089        for(unsigned jj = 0;jj<(unsigned)IDELEMS(vc)-1;jj++)
4090        {
4091          if((vc->m[jj]!=NULL)
4092          && (n_DivBy(pGetCoeff(vc->m[jj]),pGetCoeff(c),currRing->cf)))
4093          {
4094            pDelete(&vc->m[jj]);
4095          }
4096        }
4097        idSkipZeroes(vc);
4098        j = idPosConstant(vc);
4099        if (j != -1) pDelete(&vc->m[j]);
4100        dcurr = (long)scDimInt(vc, currRing->qideal);
4101        // the following assumes the ground rings to be either zero- or one-dimensional
4102        if((j==-1) && rField_is_Z(currRing))
4103        {
4104          // should also be activated for other euclidean domains as groundfield
4105          dcurr++;
4106        }
4107        idDelete(&vc);
4108      }
4109      if(dcurr > d)
4110          d = dcurr;
4111    }
4112    res->data = (char *)d;
4113    idDelete(&vv);
4114    return FALSE;
4115  }
4116#endif
4117  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4118  return FALSE;
4119}
4120static BOOLEAN jjDUMP(leftv, leftv v)
4121{
4122  si_link l = (si_link)v->Data();
4123  if (slDump(l))
4124  {
4125    const char *s;
4126    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4127    else                            s=sNoName_fe;
4128    Werror("cannot dump to `%s`",s);
4129    return TRUE;
4130  }
4131  else
4132    return FALSE;
4133}
4134static BOOLEAN jjE(leftv res, leftv v)
4135{
4136  res->data = (char *)pOne();
4137  int co=(int)(long)v->Data();
4138  if (co>0)
4139  {
4140    pSetComp((poly)res->data,co);
4141    pSetm((poly)res->data);
4142  }
4143  else WerrorS("argument of gen must be positive");
4144  return (co<=0);
4145}
4146static BOOLEAN jjEXECUTE(leftv, leftv v)
4147{
4148  char * d = (char *)v->Data();
4149  char * s = (char *)omAlloc(strlen(d) + 13);
4150  strcpy( s, (char *)d);
4151  strcat( s, "\n;RETURN();\n");
4152  newBuffer(s,BT_execute);
4153  return yyparse();
4154}
4155static BOOLEAN jjFACSTD(leftv res, leftv v)
4156{
4157  lists L=(lists)omAllocBin(slists_bin);
4158  if (currRing->cf->convSingNFactoryN!=ndConvSingNFactoryN) /* conversion to factory*/
4159  {
4160    ideal_list p,h;
4161    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4162    if (h==NULL)
4163    {
4164      L->Init(1);
4165      L->m[0].data=(char *)idInit(1);
4166      L->m[0].rtyp=IDEAL_CMD;
4167    }
4168    else
4169    {
4170      p=h;
4171      int l=0;
4172      while (p!=NULL) { p=p->next;l++; }
4173      L->Init(l);
4174      l=0;
4175      while(h!=NULL)
4176      {
4177        L->m[l].data=(char *)h->d;
4178        L->m[l].rtyp=IDEAL_CMD;
4179        p=h->next;
4180        omFreeSize(h,sizeof(*h));
4181        h=p;
4182        l++;
4183      }
4184    }
4185  }
4186  else
4187  {
4188    WarnS("no factorization implemented");
4189    L->Init(1);
4190    iiExprArith1(&(L->m[0]),v,STD_CMD);
4191  }
4192  res->data=(void *)L;
4193  return FALSE;
4194}
4195static BOOLEAN jjFAC_P(leftv res, leftv u)
4196{
4197  intvec *v=NULL;
4198  singclap_factorize_retry=0;
4199  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4200  if (f==NULL) return TRUE;
4201  ivTest(v);
4202  lists l=(lists)omAllocBin(slists_bin);
4203  l->Init(2);
4204  l->m[0].rtyp=IDEAL_CMD;
4205  l->m[0].data=(void *)f;
4206  l->m[1].rtyp=INTVEC_CMD;
4207  l->m[1].data=(void *)v;
4208  res->data=(void *)l;
4209  return FALSE;
4210}
4211static BOOLEAN jjGETDUMP(leftv, leftv v)
4212{
4213  si_link l = (si_link)v->Data();
4214  if (slGetDump(l))
4215  {
4216    const char *s;
4217    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4218    else                            s=sNoName_fe;
4219    Werror("cannot get dump from `%s`",s);
4220    return TRUE;
4221  }
4222  else
4223    return FALSE;
4224}
4225static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4226{
4227  assumeStdFlag(v);
4228  ideal I=(ideal)v->Data();
4229  res->data=(void *)iiHighCorner(I,0);
4230  return FALSE;
4231}
4232static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4233{
4234  assumeStdFlag(v);
4235  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4236  BOOLEAN delete_w=FALSE;
4237  ideal I=(ideal)v->Data();
4238  int i;
4239  poly p=NULL,po=NULL;
4240  int rk=id_RankFreeModule(I,currRing);
4241  if (w==NULL)
4242  {
4243    w = new intvec(rk);
4244    delete_w=TRUE;
4245  }
4246  for(i=rk;i>0;i--)
4247  {
4248    p=iiHighCorner(I,i);
4249    if (p==NULL)
4250    {
4251      WerrorS("module must be zero-dimensional");
4252      if (delete_w) delete w;
4253      return TRUE;
4254    }
4255    if (po==NULL)
4256    {
4257      po=p;
4258    }
4259    else
4260    {
4261      // now po!=NULL, p!=NULL
4262      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4263      if (d==0)
4264        d=pLmCmp(po,p);
4265      if (d > 0)
4266      {
4267        pDelete(&p);
4268      }
4269      else // (d < 0)
4270      {
4271        pDelete(&po); po=p;
4272      }
4273    }
4274  }
4275  if (delete_w) delete w;
4276  res->data=(void *)po;
4277  return FALSE;
4278}
4279static BOOLEAN jjHILBERT(leftv, leftv v)
4280{
4281#ifdef HAVE_RINGS
4282  if (rField_is_Z(currRing))
4283  {
4284    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
4285    PrintS("//       performed for generic fibre, that is, over Q\n");
4286  }
4287#endif
4288  assumeStdFlag(v);
4289  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4290  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4291  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4292  return FALSE;
4293}
4294static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4295{
4296#ifdef HAVE_RINGS
4297  if (rField_is_Z(currRing))
4298  {
4299    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
4300    PrintS("//       performed for generic fibre, that is, over Q\n");
4301  }
4302#endif
4303  res->data=(void *)hSecondSeries((intvec *)v->Data());
4304  return FALSE;
4305}
4306static BOOLEAN jjHOMOG1(leftv res, leftv v)
4307{
4308  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4309  ideal v_id=(ideal)v->Data();
4310  if (w==NULL)
4311  {
4312    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4313    if (res->data!=NULL)
4314    {
4315      if (v->rtyp==IDHDL)
4316      {
4317        char *s_isHomog=omStrDup("isHomog");
4318        if (v->e==NULL)
4319          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4320        else
4321          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4322      }
4323      else if (w!=NULL) delete w;
4324    } // if res->data==NULL then w==NULL
4325  }
4326  else
4327  {
4328    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4329    if((res->data==NULL) && (v->rtyp==IDHDL))
4330    {
4331      if (v->e==NULL)
4332        atKill((idhdl)(v->data),"isHomog");
4333      else
4334        atKill((idhdl)(v->LData()),"isHomog");
4335    }
4336  }
4337  return FALSE;
4338}
4339static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4340{
4341#ifdef HAVE_SHIFTBBA
4342  if (currRing->isLPring)
4343  {
4344    int deg = (int)(long)v->Data();
4345    if (deg > currRing->N/currRing->isLPring) {
4346      WerrorS("degree bound of Letterplace ring is to small");
4347      return TRUE;
4348    }
4349  }
4350#endif
4351  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4352  setFlag(res,FLAG_STD);
4353  return FALSE;
4354}
4355static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4356{
4357  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4358  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4359  if (IDELEMS((ideal)mat)==0)
4360  {
4361    idDelete((ideal *)&mat);
4362    mat=(matrix)idInit(1,1);
4363  }
4364  else
4365  {
4366    MATROWS(mat)=1;
4367    mat->rank=1;
4368    idTest((ideal)mat);
4369  }
4370  res->data=(char *)mat;
4371  return FALSE;
4372}
4373static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4374{
4375  map m=(map)v->CopyD(MAP_CMD);
4376  omFree((ADDRESS)m->preimage);
4377  m->preimage=NULL;
4378  ideal I=(ideal)m;
4379  I->rank=1;
4380  res->data=(char *)I;
4381  return FALSE;
4382}
4383static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4384{
4385  if (currRing!=NULL)
4386  {
4387    ring q=(ring)v->Data();
4388    if (rSamePolyRep(currRing, q))
4389    {
4390      if (q->qideal==NULL)
4391        res->data=(char *)idInit(1,1);
4392      else
4393        res->data=(char *)idCopy(q->qideal);
4394      return FALSE;
4395    }
4396  }
4397  WerrorS("can only get ideal from identical qring");
4398  return TRUE;
4399}
4400static BOOLEAN jjIm2Iv(leftv res, leftv v)
4401{
4402  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4403  iv->makeVector();
4404  res->data = iv;
4405  return FALSE;
4406}
4407static BOOLEAN jjIMPART(leftv res, leftv v)
4408{
4409  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4410  return FALSE;
4411}
4412static BOOLEAN jjINDEPSET(leftv res, leftv v)
4413{
4414  assumeStdFlag(v);
4415  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4416  return FALSE;
4417}
4418static BOOLEAN jjINTERRED(leftv res, leftv v)
4419{
4420  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4421#ifdef HAVE_RINGS
4422  if(rField_is_Ring(currRing))
4423    WarnS("interred: this command is experimental over the integers");
4424#endif
4425  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4426  res->data = result;
4427  return FALSE;
4428}
4429static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4430{
4431  res->data = (char *)(long)pVar((poly)v->Data());
4432  return FALSE;
4433}
4434static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4435{
4436  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4437                                                            currRing->N)+1);
4438  return FALSE;
4439}
4440static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4441{
4442  res->data = (char *)0;
4443  return FALSE;
4444}
4445static BOOLEAN jjJACOB_P(leftv res, leftv v)
4446{
4447  ideal i=idInit(currRing->N,1);
4448  int k;
4449  poly p=(poly)(v->Data());
4450  for (k=currRing->N;k>0;k--)
4451  {
4452    i->m[k-1]=pDiff(p,k);
4453  }
4454  res->data = (char *)i;
4455  return FALSE;
4456}
4457static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4458{
4459  if (!nCoeff_is_transExt(currRing->cf))
4460  {
4461    WerrorS("differentiation not defined in the coefficient ring");
4462    return TRUE;
4463  }
4464  number n = (number) u->Data();
4465  number k = (number) v->Data();
4466  res->data = ntDiff(n,k,currRing->cf);
4467  return FALSE;
4468}
4469/*2
4470 * compute Jacobi matrix of a module/matrix
4471 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4472 * where Mt := transpose(M)
4473 * Note that this is consistent with the current conventions for jacob in Singular,
4474 * whereas M2 computes its transposed.
4475 */
4476static BOOLEAN jjJACOB_M(leftv res, leftv a)
4477{
4478  ideal id = (ideal)a->Data();
4479  id = id_Transp(id,currRing);
4480  int W = IDELEMS(id);
4481
4482  ideal result = idInit(W * currRing->N, id->rank);
4483  poly *p = result->m;
4484
4485  for( int v = 1; v <= currRing->N; v++ )
4486  {
4487    poly* q = id->m;
4488    for( int i = 0; i < W; i++, p++, q++ )
4489      *p = pDiff( *q, v );
4490  }
4491  idDelete(&id);
4492
4493  res->data = (char *)result;
4494  return FALSE;
4495}
4496
4497static BOOLEAN jjKBASE(leftv res, leftv v)
4498{
4499  assumeStdFlag(v);
4500  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4501  return FALSE;
4502}
4503static BOOLEAN jjL2R(leftv res, leftv v)
4504{
4505  res->data=(char *)syConvList((lists)v->Data());
4506  if (res->data != NULL)
4507    return FALSE;
4508  else
4509    return TRUE;
4510}
4511static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4512{
4513  poly p=(poly)v->Data();
4514  if (p==NULL)
4515  {
4516    res->data=(char *)nInit(0);
4517  }
4518  else
4519  {
4520    nNormalize(pGetCoeff(p));
4521    res->data=(char *)nCopy(pGetCoeff(p));
4522  }
4523  return FALSE;
4524}
4525static BOOLEAN jjLEADEXP(leftv res, leftv v)
4526{
4527  poly p=(poly)v->Data();
4528  int s=currRing->N;
4529  if (v->Typ()==VECTOR_CMD) s++;
4530  intvec *iv=new intvec(s);
4531  if (p!=NULL)
4532  {
4533    for(int i = currRing->N;i;i--)
4534    {
4535      (*iv)[i-1]=pGetExp(p,i);
4536    }
4537    if (s!=currRing->N)
4538      (*iv)[currRing->N]=pGetComp(p);
4539  }
4540  res->data=(char *)iv;
4541  return FALSE;
4542}
4543static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4544{
4545  poly p=(poly)v->Data();
4546  if (p == NULL)
4547  {
4548    res->data = (char*) NULL;
4549  }
4550  else
4551  {
4552    poly lm = pLmInit(p);
4553    pSetCoeff0(lm, nInit(1));
4554    res->data = (char*) lm;
4555  }
4556  return FALSE;
4557}
4558static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4559{
4560  return jjLOAD((char*)v->Data(),FALSE);
4561}
4562static BOOLEAN jjLISTRING(leftv res, leftv v)
4563{
4564  lists l=(lists)v->Data();
4565  long mm=(long)atGet(v,"maxExp",INT_CMD);
4566  if (mm==0) mm=0x7fff;
4567  int isLetterplace=(int)(long)atGet(v,"isLetterplaceRing",INT_CMD);
4568  ring r=rCompose(l,TRUE,mm,isLetterplace);
4569  res->data=(char *)r;
4570  return (r==NULL);
4571}
4572static BOOLEAN jjPFAC1(leftv res, leftv v)
4573{
4574  /* call method jjPFAC2 with second argument = 0 (meaning that no
4575     valid bound for the prime factors has been given) */
4576  sleftv tmp;
4577  memset(&tmp, 0, sizeof(tmp));
4578  tmp.rtyp = INT_CMD;
4579  return jjPFAC2(res, v, &tmp);
4580}
4581static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4582{
4583  /* computes the LU-decomposition of a matrix M;
4584     i.e., M = P * L * U, where
4585        - P is a row permutation matrix,
4586        - L is in lower triangular form,
4587        - U is in upper row echelon form
4588     Then, we also have P * M = L * U.
4589     A list [P, L, U] is returned. */
4590  matrix mat = (const matrix)v->Data();
4591  if (!idIsConstant((ideal)mat))
4592  {
4593    WerrorS("matrix must be constant");
4594    return TRUE;
4595  }
4596  matrix pMat;
4597  matrix lMat;
4598  matrix uMat;
4599
4600  luDecomp(mat, pMat, lMat, uMat);
4601
4602  lists ll = (lists)omAllocBin(slists_bin);
4603  ll->Init(3);
4604  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4605  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4606  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4607  res->data=(char*)ll;
4608
4609  return FALSE;
4610}
4611static BOOLEAN jjMEMORY(leftv res, leftv v)
4612{
4613  // clean out "_":
4614  sLastPrinted.CleanUp();
4615  memset(&sLastPrinted,0,sizeof(sleftv));
4616  // collect all info:
4617  omUpdateInfo();
4618  switch(((int)(long)v->Data()))
4619  {
4620  case 0:
4621    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4622    break;
4623  case 1:
4624    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4625    break;
4626  case 2:
4627    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4628    break;
4629  default:
4630    omPrintStats(stdout);
4631    omPrintInfo(stdout);
4632    omPrintBinStats(stdout);
4633    res->data = (char *)0;
4634    res->rtyp = NONE;
4635  }
4636  return FALSE;
4637  res->data = (char *)0;
4638  return FALSE;
4639}
4640//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4641//{
4642//  return jjMONITOR2(res,v,NULL);
4643//}
4644static BOOLEAN jjMSTD(leftv res, leftv v)
4645{
4646  int t=v->Typ();
4647  ideal r,m;
4648  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4649  lists l=(lists)omAllocBin(slists_bin);
4650  l->Init(2);
4651  l->m[0].rtyp=t;
4652  l->m[0].data=(char *)r;
4653  setFlag(&(l->m[0]),FLAG_STD);
4654  l->m[1].rtyp=t;
4655  l->m[1].data=(char *)m;
4656  res->data=(char *)l;
4657  return FALSE;
4658}
4659static BOOLEAN jjMULT(leftv res, leftv v)
4660{
4661  assumeStdFlag(v);
4662  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4663  return FALSE;
4664}
4665static BOOLEAN jjMINRES_R(leftv res, leftv v)
4666{
4667  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4668
4669  syStrategy tmp=(syStrategy)v->Data();
4670  tmp = syMinimize(tmp); // enrich itself!
4671
4672  res->data=(char *)tmp;
4673
4674  if (weights!=NULL)
4675    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4676
4677  return FALSE;
4678}
4679static BOOLEAN jjN2BI(leftv res, leftv v)
4680{
4681  number n,i; i=(number)v->Data();
4682  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4683  if (nMap!=NULL)
4684    n=nMap(i,currRing->cf,coeffs_BIGINT);
4685  else goto err;
4686  res->data=(void *)n;
4687  return FALSE;
4688err:
4689  WerrorS("cannot convert to bigint"); return TRUE;
4690}
4691static BOOLEAN jjNAMEOF(leftv res, leftv v)
4692{
4693  if ((v->rtyp==IDHDL)||(v->rtyp==ALIAS_CMD))
4694    res->data=omStrDup(v->name);
4695  else if (v->name==NULL)
4696    res->data=omStrDup("");
4697  else
4698  {
4699    res->data = (char *)v->name;
4700    v->name=NULL;
4701  }
4702  return FALSE;
4703}
4704static BOOLEAN jjNAMES(leftv res, leftv v)
4705{
4706  res->data=ipNameList(((ring)v->Data())->idroot);
4707  return FALSE;
4708}
4709static BOOLEAN jjNAMES_I(leftv res, leftv v)
4710{
4711  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4712  return FALSE;
4713}
4714static BOOLEAN jjNOT(leftv res, leftv v)
4715{
4716  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4717  return FALSE;
4718}
4719static BOOLEAN jjNVARS(leftv res, leftv v)
4720{
4721  res->data = (char *)(long)(((ring)(v->Data()))->N);
4722  return FALSE;
4723}
4724static BOOLEAN jjOpenClose(leftv, leftv v)
4725{
4726  si_link l=(si_link)v->Data();
4727  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4728  else { slPrepClose(l); return slClose(l);}
4729}
4730static BOOLEAN jjORD(leftv res, leftv v)
4731{
4732  poly p=(poly)v->Data();
4733  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4734  return FALSE;
4735}
4736static BOOLEAN jjPAR1(leftv res, leftv v)
4737{
4738  int i=(int)(long)v->Data();
4739  int p=0;
4740  p=rPar(currRing);
4741  if ((0<i) && (i<=p))
4742  {
4743    res->data=(char *)n_Param(i,currRing);
4744  }
4745  else
4746  {
4747    Werror("par number %d out of range 1..%d",i,p);
4748    return TRUE;
4749  }
4750  return FALSE;
4751}
4752static BOOLEAN jjPARDEG(leftv res, leftv v)
4753{
4754  number nn=(number)v->Data();
4755  res->data = (char *)(long)n_ParDeg(nn, currRing->cf);
4756  return FALSE;
4757}
4758static BOOLEAN jjPARSTR1(leftv res, leftv v)
4759{
4760  if (currRing==NULL)
4761  {
4762    WerrorS("no ring active (1)");
4763    return TRUE;
4764  }
4765  int i=(int)(long)v->Data();
4766  int p=0;
4767  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4768    res->data=omStrDup(rParameter(currRing)[i-1]);
4769  else
4770  {
4771    Werror("par number %d out of range 1..%d",i,p);
4772    return TRUE;
4773  }
4774  return FALSE;
4775}
4776static BOOLEAN jjP2BI(leftv res, leftv v)
4777{
4778  poly p=(poly)v->Data();
4779  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4780  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4781  {
4782    WerrorS("poly must be constant");
4783    return TRUE;
4784  }
4785  number i=pGetCoeff(p);
4786  number n;
4787  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4788  if (nMap!=NULL)
4789    n=nMap(i,currRing->cf,coeffs_BIGINT);
4790  else goto err;
4791  res->data=(void *)n;
4792  return FALSE;
4793err:
4794  WerrorS("cannot convert to bigint"); return TRUE;
4795}
4796static BOOLEAN jjP2I(leftv res, leftv v)
4797{
4798  poly p=(poly)v->Data();
4799  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4800  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4801  {
4802    WerrorS("poly must be constant");
4803    return TRUE;
4804  }
4805  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4806  return FALSE;
4807}
4808static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4809{
4810  map mapping=(map)v->Data();
4811  syMake(res,omStrDup(mapping->preimage));
4812  return FALSE;
4813}
4814static BOOLEAN jjPRIME(leftv res, leftv v)
4815{
4816  int i = IsPrime((int)(long)(v->Data()));
4817  res->data = (char *)(long)(i > 1 ? i : 2);
4818  return FALSE;
4819}
4820static BOOLEAN jjPRUNE(leftv res, leftv v)
4821{
4822  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4823  ideal v_id=(ideal)v->Data();
4824  if (w!=NULL)
4825  {
4826    if (!idTestHomModule(v_id,currRing->qideal,w))
4827    {
4828      WarnS("wrong weights");
4829      w=NULL;
4830      // and continue at the non-homog case below
4831    }
4832    else
4833    {
4834      w=ivCopy(w);
4835      intvec **ww=&w;
4836      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4837      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4838      return FALSE;
4839    }
4840  }
4841  res->data = (char *)idMinEmbedding(v_id);
4842  return FALSE;
4843}
4844static BOOLEAN jjP2N(leftv res, leftv v)
4845{
4846  number n;
4847  poly p;
4848  if (((p=(poly)v->Data())!=NULL)
4849  && (pIsConstant(p)))
4850  {
4851    n=nCopy(pGetCoeff(p));
4852  }
4853  else
4854  {
4855    n=nInit(0);
4856  }
4857  res->data = (char *)n;
4858  return FALSE;
4859}
4860static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4861{
4862  char *s= (char *)v->Data();
4863  // try system keywords
4864  for(unsigned i=0; i<sArithBase.nCmdUsed; i++)
4865  {
4866    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4867    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4868    {
4869      res->data = (char *)1;
4870      return FALSE;
4871    }
4872  }
4873  // try blackbox names
4874  int id;
4875  blackboxIsCmd(s,id);
4876  if (id>0)
4877  {
4878    res->data = (char *)1;
4879  }
4880  return FALSE;
4881}
4882static BOOLEAN jjRANK1(leftv res, leftv v)
4883{
4884  matrix m =(matrix)v->Data();
4885  int rank = luRank(m, 0);
4886  res->data =(char *)(long)rank;
4887  return FALSE;
4888}
4889static BOOLEAN jjREAD(leftv res, leftv v)
4890{
4891  return jjREAD2(res,v,NULL);
4892}
4893static BOOLEAN jjREGULARITY(leftv res, leftv v)
4894{
4895  res->data = (char *)(long)iiRegularity((lists)v->Data());
4896  return FALSE;
4897}
4898static BOOLEAN jjREPART(leftv res, leftv v)
4899{
4900  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4901  return FALSE;
4902}
4903static BOOLEAN jjRINGLIST(leftv res, leftv v)
4904{
4905  ring r=(ring)v->Data();
4906  if (r!=NULL)
4907  {
4908    res->data = (char *)rDecompose((ring)v->Data());
4909    if (res->data!=NULL)
4910    {
4911      long mm=r->bitmask/2;
4912      if (mm>MAX_INT_VAL) mm=MAX_INT_VAL;
4913      atSet(res,omStrDup("maxExp"),(void*)mm,INT_CMD);
4914      return FALSE;
4915    }
4916  }
4917  return TRUE;
4918}
4919static BOOLEAN jjRINGLIST_C(leftv res, leftv v)
4920{
4921  coeffs r=(coeffs)v->Data();
4922  if (r!=NULL)
4923    return rDecompose_CF(res,r);
4924  return TRUE;
4925}
4926static BOOLEAN jjRING_LIST(leftv res, leftv v)
4927{
4928  ring r=(ring)v->Data();
4929  if (r!=NULL)
4930    res->data = (char *)rDecompose_list_cf((ring)v->Data());
4931  return (r==NULL)||(res->data==NULL);
4932}
4933static BOOLEAN jjROWS(leftv res, leftv v)
4934{
4935  ideal i = (ideal)v->Data();
4936  res->data = (char *)i->rank;
4937  return FALSE;
4938}
4939static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4940{
4941  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4942  return FALSE;
4943}
4944static BOOLEAN jjROWS_IV(leftv res, leftv v)
4945{
4946  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4947  return FALSE;
4948}
4949static BOOLEAN jjRPAR(leftv res, leftv v)
4950{
4951  res->data = (char *)(long)rPar(((ring)v->Data()));
4952  return FALSE;
4953}
4954static BOOLEAN jjS2I(leftv res, leftv v)
4955{
4956  res->data = (char *)(long)atoi((char*)v->Data());
4957  return FALSE;
4958}
4959static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4960{
4961  const bool bIsSCA = rIsSCA(currRing);
4962
4963  if ((currRing->qideal!=NULL) && !bIsSCA)
4964  {
4965    WerrorS("qring not supported by slimgb at the moment");
4966    return TRUE;
4967  }
4968  if (rHasLocalOrMixedOrdering(currRing))
4969  {
4970    WerrorS("ordering must be global for slimgb");
4971    return TRUE;
4972  }
4973  if (rField_is_numeric(currRing))
4974    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
4975  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4976  // tHomog hom=testHomog;
4977  ideal u_id=(ideal)u->Data();
4978  if (w!=NULL)
4979  {
4980    if (!idTestHomModule(u_id,currRing->qideal,w))
4981    {
4982      WarnS("wrong weights");
4983      w=NULL;
4984    }
4985    else
4986    {
4987      w=ivCopy(w);
4988      // hom=isHomog;
4989    }
4990  }
4991
4992  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4993  res->data=(char *)t_rep_gb(currRing,
4994    u_id,u_id->rank);
4995  //res->data=(char *)t_rep_gb(currRing, u_id);
4996
4997  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4998  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4999  return FALSE;
5000}
5001static BOOLEAN jjSBA(leftv res, leftv v)
5002{
5003  ideal result;
5004  ideal v_id=(ideal)v->Data();
5005  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5006  tHomog hom=testHomog;
5007  if (w!=NULL)
5008  {
5009    if (!idTestHomModule(v_id,currRing->qideal,w))
5010    {
5011      WarnS("wrong weights");
5012      w=NULL;
5013    }
5014    else
5015    {
5016      hom=isHomog;
5017      w=ivCopy(w);
5018    }
5019  }
5020  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
5021  idSkipZeroes(result);
5022  res->data = (char *)result;
5023  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5024  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5025  return FALSE;
5026}
5027static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
5028{
5029  ideal result;
5030  ideal v_id=(ideal)v->Data();
5031  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5032  tHomog hom=testHomog;
5033  if (w!=NULL)
5034  {
5035    if (!idTestHomModule(v_id,currRing->qideal,w))
5036    {
5037      WarnS("wrong weights");
5038      w=NULL;
5039    }
5040    else
5041    {
5042      hom=isHomog;
5043      w=ivCopy(w);
5044    }
5045  }
5046  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
5047  idSkipZeroes(result);
5048  res->data = (char *)result;
5049  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5050  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5051  return FALSE;
5052}
5053static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
5054{
5055  ideal result;
5056  ideal v_id=(ideal)v->Data();
5057  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5058  tHomog hom=testHomog;
5059  if (w!=NULL)
5060  {
5061    if (!idTestHomModule(v_id,currRing->qideal,w))
5062    {
5063      WarnS("wrong weights");
5064      w=NULL;
5065    }
5066    else
5067    {
5068      hom=isHomog;
5069      w=ivCopy(w);
5070    }
5071  }
5072  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
5073  idSkipZeroes(result);
5074  res->data = (char *)result;
5075  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5076  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5077  return FALSE;
5078}
5079static BOOLEAN jjSTD(leftv res, leftv v)
5080{
5081  if (rField_is_numeric(currRing))
5082    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5083  ideal result;
5084  ideal v_id=(ideal)v->Data();
5085  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5086  tHomog hom=testHomog;
5087  if (w!=NULL)
5088  {
5089    if (!idTestHomModule(v_id,currRing->qideal,w))
5090    {
5091      WarnS("wrong weights");
5092      w=NULL;
5093    }
5094    else
5095    {
5096      hom=isHomog;
5097      w=ivCopy(w);
5098    }
5099  }
5100  result=kStd(v_id,currRing->qideal,hom,&w);
5101  idSkipZeroes(result);
5102  res->data = (char *)result;
5103  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5104  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5105  return FALSE;
5106}
5107static BOOLEAN jjSort_Id(leftv res, leftv v)
5108{
5109  res->data = (char *)idSort((ideal)v->Data());
5110  return FALSE;
5111}
5112static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5113{
5114  singclap_factorize_retry=0;
5115  intvec *v=NULL;
5116  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5117  if (f==NULL) return TRUE;
5118  ivTest(v);
5119  lists l=(lists)omAllocBin(slists_bin);
5120  l->Init(2);
5121  l->m[0].rtyp=IDEAL_CMD;
5122  l->m[0].data=(void *)f;
5123  l->m[1].rtyp=INTVEC_CMD;
5124  l->m[1].data=(void *)v;
5125  res->data=(void *)l;
5126  return FALSE;
5127}
5128#if 0
5129static BOOLEAN jjSYZYGY(leftv res, leftv v)
5130{
5131  intvec *w=NULL;
5132  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5133  if (w!=NULL) delete w;
5134  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5135  return FALSE;
5136}
5137#else
5138// activate, if idSyz handle module weights correctly !
5139static BOOLEAN jjSYZYGY(leftv res, leftv v)
5140{
5141  intvec *ww=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5142  intvec *w=NULL;
5143  ideal v_id=(ideal)v->Data();
5144  tHomog hom=testHomog;
5145#ifdef HAVE_SHIFTBBA
5146  if (rIsLPRing(currRing))
5147  {
5148    if (currRing->LPncGenCount < IDELEMS(v_id))
5149    {
5150      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS(v_id));
5151      return TRUE;
5152    }
5153  }
5154#endif
5155  if (ww!=NULL)
5156  {
5157    if (idTestHomModule(v_id,currRing->qideal,ww))
5158    {
5159      w=ivCopy(ww);
5160      int add_row_shift=w->min_in();
5161      (*w)-=add_row_shift;
5162      hom=isHomog;
5163    }
5164    else
5165    {
5166      //WarnS("wrong weights");
5167      delete ww; ww=NULL;
5168      hom=testHomog;
5169    }
5170  }
5171  else
5172  {
5173    if (v->Typ()==IDEAL_CMD)
5174      if (idHomIdeal(v_id,currRing->qideal))
5175        hom=isHomog;
5176  }
5177  ideal S=idSyzygies(v_id,hom,&w);
5178  res->data = (char *)S;
5179  if (hom==isHomog)
5180  {
5181    int vl=S->rank;
5182    intvec *vv=new intvec(vl);
5183    if ((v->Typ()==IDEAL_CMD)||(ww==NULL))
5184    {
5185      for(int i=0;i<vl;i++)
5186      {
5187        if (v_id->m[i]!=NULL)
5188          (*vv)[i]=p_Deg(v_id->m[i],currRing);
5189      }
5190    }
5191    else
5192    {
5193      p_SetModDeg(ww, currRing);
5194      for(int i=0;i<vl;i++)
5195      {
5196        if (v_id->m[i]!=NULL)
5197          (*vv)[i]=currRing->pFDeg(v_id->m[i],currRing);
5198      }
5199      p_SetModDeg(NULL, currRing);
5200    }
5201    if (idTestHomModule(S,currRing->qideal,vv))
5202      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
5203    else
5204      delete vv;
5205  }
5206  if (w!=NULL) delete w;
5207  return FALSE;
5208}
5209#endif
5210static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5211{
5212  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5213  return FALSE;
5214}
5215static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5216{
5217  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5218  return FALSE;
5219}
5220static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5221{
5222  res->data = (char *)ivTranp((intvec*)(v->Data()));
5223  return FALSE;
5224}
5225#ifdef HAVE_PLURAL
5226static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5227{
5228  ring    r = (ring)a->Data();
5229  //if (rIsPluralRing(r))
5230  if (r->OrdSgn==1)
5231  {
5232    res->data = rOpposite(r);
5233  }
5234  else
5235  {
5236    WarnS("opposite only for global orderings");
5237    res->data = rCopy(r);
5238  }
5239  return FALSE;
5240}
5241static BOOLEAN jjENVELOPE(leftv res, leftv a)
5242{
5243  ring    r = (ring)a->Data();
5244  if (rIsPluralRing(r))
5245  {
5246    ring s = rEnvelope(r);
5247    res->data = s;
5248  }
5249  else  res->data = rCopy(r);
5250  return FALSE;
5251}
5252static BOOLEAN jjTWOSTD(leftv res, leftv a)
5253{
5254  ideal result;
5255  ideal v_id=(ideal)a->Data();
5256  if (rIsPluralRing(currRing))
5257    result=(ideal)twostd(v_id);
5258  else /*commutative or shiftalgebra*/
5259  {
5260    return jjSTD(res,a);
5261  }
5262  res->data = (char *)result;
5263  setFlag(res,FLAG_STD);
5264  setFlag(res,FLAG_TWOSTD);
5265  return FALSE;
5266}
5267#endif
5268#if defined(HAVE_SHIFTBBA) || defined(HAVE_PLURAL)// do not place above jjSTD in this file because we need to reference it
5269static BOOLEAN jjRIGHTSTD(leftv res, leftv v)
5270{
5271  if (rIsLPRing(currRing))
5272  {
5273    if (rField_is_numeric(currRing))
5274      WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5275    ideal result;
5276    ideal v_id=(ideal)v->Data();
5277    /* intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD); */
5278    /* tHomog hom=testHomog; */
5279    /* if (w!=NULL) */
5280    /* { */
5281    /*   if (!idTestHomModule(v_id,currRing->qideal,w)) */
5282    /*   { */
5283    /*     WarnS("wrong weights"); */
5284    /*     w=NULL; */
5285    /*   } */
5286    /*   else */
5287    /*   { */
5288    /*     hom=isHomog; */
5289    /*     w=ivCopy(w); */
5290    /*   } */
5291    /* } */
5292    /* result=kStd(v_id,currRing->qideal,hom,&w); */
5293    result = rightgb(v_id, currRing->qideal);
5294    idSkipZeroes(result);
5295    res->data = (char *)result;
5296    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5297    /* if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD); */
5298    return FALSE;
5299  }
5300  else if (rIsPluralRing(currRing))
5301  {
5302    ideal I=(ideal)v->Data();
5303
5304    ring A = currRing;
5305    ring Aopp = rOpposite(A);
5306    currRing = Aopp;
5307    ideal Iopp = idOppose(A, I, Aopp);
5308    ideal Jopp = kStd(Iopp,currRing->qideal,testHomog,NULL);
5309    currRing = A;
5310    ideal J = idOppose(Aopp, Jopp, A);
5311
5312    id_Delete(&Iopp, Aopp);
5313    id_Delete(&Jopp, Aopp);
5314    rDelete(Aopp);
5315
5316    idSkipZeroes(J);
5317    res->data = (char *)J;
5318    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5319    return FALSE;
5320  }
5321  else
5322  {
5323    return jjSTD(res, v);
5324  }
5325}
5326#endif
5327static BOOLEAN jjTYPEOF(leftv res, leftv v)
5328{
5329  int t=(int)(long)v->data;
5330  switch (t)
5331  {
5332    case CRING_CMD:
5333    case INT_CMD:
5334    case POLY_CMD:
5335    case VECTOR_CMD:
5336    case STRING_CMD:
5337    case INTVEC_CMD:
5338    case IDEAL_CMD:
5339    case MATRIX_CMD:
5340    case MODUL_CMD:
5341    case MAP_CMD:
5342    case PROC_CMD:
5343    case RING_CMD:
5344    case SMATRIX_CMD:
5345    //case QRING_CMD:
5346    case INTMAT_CMD:
5347    case BIGINTMAT_CMD:
5348    case NUMBER_CMD:
5349    #ifdef SINGULAR_4_2
5350    case CNUMBER_CMD:
5351    #endif
5352    case BIGINT_CMD:
5353    case BUCKET_CMD:
5354    case LIST_CMD:
5355    case PACKAGE_CMD:
5356    case LINK_CMD:
5357    case RESOLUTION_CMD:
5358         res->data=omStrDup(Tok2Cmdname(t)); break;
5359    case DEF_CMD:
5360    case NONE:           res->data=omStrDup("none"); break;
5361    default:
5362    {
5363      if (t>MAX_TOK)
5364        res->data=omStrDup(getBlackboxName(t));
5365      else
5366        res->data=omStrDup("?unknown type?");
5367      break;
5368    }
5369  }
5370  return FALSE;
5371}
5372static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5373{
5374  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5375  return FALSE;
5376}
5377static BOOLEAN jjVAR1(leftv res, leftv v)
5378{
5379  int i=(int)(long)v->Data();
5380  if ((0<i) && (i<=currRing->N))
5381  {
5382    poly p=pOne();
5383    pSetExp(p,i,1);
5384    pSetm(p);
5385    res->data=(char *)p;
5386  }
5387  else
5388  {
5389    Werror("var number %d out of range 1..%d",i,currRing->N);
5390    return TRUE;
5391  }
5392  return FALSE;
5393}
5394static BOOLEAN jjVARSTR1(leftv res, leftv v)
5395{
5396  if (currRing==NULL)
5397  {
5398    WerrorS("no ring active (2)");
5399    return TRUE;
5400  }
5401  int i=(int)(long)v->Data();
5402  if ((0<i) && (i<=currRing->N))
5403    res->data=omStrDup(currRing->names[i-1]);
5404  else
5405  {
5406    Werror("var number %d out of range 1..%d",i,currRing->N);
5407    return TRUE;
5408  }
5409  return FALSE;
5410}
5411static BOOLEAN jjVDIM(leftv res, leftv v)
5412{
5413  assumeStdFlag(v);
5414  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5415  return FALSE;
5416}
5417BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5418{
5419// input: u: a list with links of type
5420//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5421// returns: -1:  the read state of all links is eof
5422//          i>0: (at least) u[i] is ready
5423  lists Lforks = (lists)u->Data();
5424  int i = slStatusSsiL(Lforks, -1);
5425  if(i == -2) /* error */
5426  {
5427    return TRUE;
5428  }
5429  res->data = (void*)(long)i;
5430  return FALSE;
5431}
5432BOOLEAN jjWAITALL1(leftv res, leftv u)
5433{
5434// input: u: a list with links of type
5435//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5436// returns: -1: the read state of all links is eof
5437//           1: all links are ready
5438//              (caution: at least one is ready, but some maybe dead)
5439  lists Lforks = (lists)u->CopyD();
5440  int i;
5441  int j = -1;
5442  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5443  {
5444    i = slStatusSsiL(Lforks, -1);
5445    if(i == -2) /* error */
5446    {
5447      return TRUE;
5448    }
5449    if(i == -1)
5450    {
5451      break;
5452    }
5453    j = 1;
5454    Lforks->m[i-1].CleanUp();
5455    Lforks->m[i-1].rtyp=DEF_CMD;
5456    Lforks->m[i-1].data=NULL;
5457  }
5458  res->data = (void*)(long)j;
5459  Lforks->Clean();
5460  return FALSE;
5461}
5462
5463BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5464{
5465  char libnamebuf[1024];
5466  lib_types LT = type_of_LIB(s, libnamebuf);
5467
5468#ifdef HAVE_DYNAMIC_LOADING
5469  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5470#endif /* HAVE_DYNAMIC_LOADING */
5471  switch(LT)
5472  {
5473      default:
5474      case LT_NONE:
5475        Werror("%s: unknown type", s);
5476        break;
5477      case LT_NOTFOUND:
5478        Werror("cannot open %s", s);
5479        break;
5480
5481      case LT_SINGULAR:
5482      {
5483        char *plib = iiConvName(s);
5484        idhdl pl = IDROOT->get_level(plib,0);
5485        if (pl==NULL)
5486        {
5487          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5488          IDPACKAGE(pl)->language = LANG_SINGULAR;
5489          IDPACKAGE(pl)->libname=omStrDup(s);
5490        }
5491        else if (IDTYP(pl)!=PACKAGE_CMD)
5492        {
5493          Werror("can not create package `%s`",plib);
5494          omFree(plib);
5495          return TRUE;
5496        }
5497        else /* package */
5498        {
5499          package pa=IDPACKAGE(pl);
5500          if ((pa->language==LANG_C)
5501          || (pa->language==LANG_MIX))
5502          {
5503            Werror("can not create package `%s` - binaries  exists",plib);
5504            omfree(plib);
5505            return TRUE;
5506          }
5507        }
5508        omFree(plib);
5509        package savepack=currPack;
5510        currPack=IDPACKAGE(pl);
5511        IDPACKAGE(pl)->loaded=TRUE;
5512        char libnamebuf[1024];
5513        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5514        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5515        currPack=savepack;
5516        IDPACKAGE(pl)->loaded=(!bo);
5517        return bo;
5518      }
5519      case LT_BUILTIN:
5520        SModulFunc_t iiGetBuiltinModInit(const char*);
5521        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5522      case LT_MACH_O:
5523      case LT_ELF:
5524      case LT_HPUX:
5525#ifdef HAVE_DYNAMIC_LOADING
5526        return load_modules(s, libnamebuf, autoexport);
5527#else /* HAVE_DYNAMIC_LOADING */
5528        WerrorS("Dynamic modules are not supported by this version of Singular");
5529        break;
5530#endif /* HAVE_DYNAMIC_LOADING */
5531  }
5532  return TRUE;
5533}
5534STATIC_VAR int WerrorS_dummy_cnt=0;
5535static void WerrorS_dummy(const char *)
5536{
5537  WerrorS_dummy_cnt++;
5538}
5539BOOLEAN jjLOAD_TRY(const char *s)
5540{
5541  if (!iiGetLibStatus(s))
5542  {
5543    void (*WerrorS_save)(const char *s) = WerrorS_callback;
5544    WerrorS_callback=WerrorS_dummy;
5545    WerrorS_dummy_cnt=0;
5546    BOOLEAN bo=jjLOAD(s,TRUE);
5547    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5548      Print("loading of >%s< failed\n",s);
5549    WerrorS_callback=WerrorS_save;
5550    errorreported=0;
5551  }
5552  return FALSE;
5553}
5554
5555static BOOLEAN jjstrlen(leftv res, leftv v)
5556{
5557  res->data = (char *)strlen((char *)v->Data());
5558  return FALSE;
5559}
5560static BOOLEAN jjpLength(leftv res, leftv v)
5561{
5562  res->data = (char *)(long)pLength((poly)v->Data());
5563  return FALSE;
5564}
5565static BOOLEAN jjidElem(leftv res, leftv v)
5566{
5567  res->data = (char *)(long)idElem((ideal)v->Data());
5568  return FALSE;
5569}
5570static BOOLEAN jjidFreeModule(leftv res, leftv v)
5571{
5572  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5573  return FALSE;
5574}
5575static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5576{
5577  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5578  return FALSE;
5579}
5580static BOOLEAN jjrCharStr(leftv res, leftv v)
5581{
5582  res->data = rCharStr((ring)v->Data());
5583  return FALSE;
5584}
5585static BOOLEAN jjpHead(leftv res, leftv v)
5586{
5587  res->data = (char *)pHead((poly)v->Data());
5588  return FALSE;
5589}
5590static BOOLEAN jjidHead(leftv res, leftv v)
5591{
5592  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5593  setFlag(res,FLAG_STD);
5594  return FALSE;
5595}
5596static BOOLEAN jjidMinBase(leftv res, leftv v)
5597{
5598  res->data = (char *)idMinBase((ideal)v->Data());
5599  return FALSE;
5600}
5601#if 0 // unused
5602static BOOLEAN jjsyMinBase(leftv res, leftv v)
5603{
5604  res->data = (char *)syMinBase((ideal)v->Data());
5605  return FALSE;
5606}
5607#endif
5608static BOOLEAN jjpMaxComp(leftv res, leftv v)
5609{
5610  res->data = (char *)pMaxComp((poly)v->Data());
5611  return FALSE;
5612}
5613static BOOLEAN jjmpTrace(leftv res, leftv v)
5614{
5615  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5616  return FALSE;
5617}
5618static BOOLEAN jjmpTransp(leftv res, leftv v)
5619{
5620  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5621  return FALSE;
5622}
5623static BOOLEAN jjrOrdStr(leftv res, leftv v)
5624{
5625  res->data = rOrdStr((ring)v->Data());
5626  return FALSE;
5627}
5628static BOOLEAN jjrVarStr(leftv res, leftv v)
5629{
5630  res->data = rVarStr((ring)v->Data());
5631  return FALSE;
5632}
5633static BOOLEAN jjrParStr(leftv res, leftv v)
5634{
5635  res->data = rParStr((ring)v->Data());
5636  return FALSE;
5637}
5638static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5639{
5640  res->data=(char *)(long)sySize((syStrategy)v->Data());
5641  return FALSE;
5642}
5643static BOOLEAN jjDIM_R(leftv res, leftv v)
5644{
5645  res->data = (char *)(long)syDim((syStrategy)v->Data());
5646  return FALSE;
5647}
5648static BOOLEAN jjidTransp(leftv res, leftv v)
5649{
5650  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5651  return FALSE;
5652}
5653static BOOLEAN jjnInt(leftv res, leftv u)
5654{
5655  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5656  res->data=(char *)(long)iin_Int(n,currRing->cf);
5657  n_Delete(&n,currRing->cf);
5658  return FALSE;
5659}
5660static BOOLEAN jjnlInt(leftv res, leftv u)
5661{
5662  number n=(number)u->Data();
5663  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5664  return FALSE;
5665}
5666/*=================== operations with 3 args.: static proc =================*/
5667/* must be ordered: first operations for chars (infix ops),
5668 * then alphabetically */
5669static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5670{
5671  char *s= (char *)u->Data();
5672  int   r = (int)(long)v->Data();
5673  int   c = (int)(long)w->Data();
5674  int l = strlen(s);
5675
5676  if ( (r<1) || (r>l) || (c<0) )
5677  {
5678    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5679    return TRUE;
5680  }
5681  res->data = (char *)omAlloc((long)(c+1));
5682  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5683  return FALSE;
5684}
5685static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5686{
5687  intvec *iv = (intvec *)u->Data();
5688  int   r = (int)(long)v->Data();
5689  int   c = (int)(long)w->Data();
5690  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5691  {
5692    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5693           r,c,u->Fullname(),iv->rows(),iv->cols());
5694    return TRUE;
5695  }
5696  res->data=u->data; u->data=NULL;
5697  res->rtyp=u->rtyp; u->rtyp=0;
5698  res->name=u->name; u->name=NULL;
5699  Subexpr e=jjMakeSub(v);
5700          e->next=jjMakeSub(w);
5701  if (u->e==NULL) res->e=e;
5702  else
5703  {
5704    Subexpr h=u->e;
5705    while (h->next!=NULL) h=h->next;
5706    h->next=e;
5707    res->e=u->e;
5708    u->e=NULL;
5709  }
5710  return FALSE;
5711}
5712static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5713{
5714  bigintmat *bim = (bigintmat *)u->Data();
5715  int   r = (int)(long)v->Data();
5716  int   c = (int)(long)w->Data();
5717  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5718  {
5719    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5720           r,c,u->Fullname(),bim->rows(),bim->cols());
5721    return TRUE;
5722  }
5723  res->data=u->data; u->data=NULL;
5724  res->rtyp=u->rtyp; u->rtyp=0;
5725  res->name=u->name; u->name=NULL;
5726  Subexpr e=jjMakeSub(v);
5727          e->next=jjMakeSub(w);
5728  if (u->e==NULL)
5729    res->e=e;
5730  else
5731  {
5732    Subexpr h=u->e;
5733    while (h->next!=NULL) h=h->next;
5734    h->next=e;
5735    res->e=u->e;
5736    u->e=NULL;
5737  }
5738  return FALSE;
5739}
5740static BOOLEAN jjBRACK_Ma