source: git/Singular/iparith.cc @ 066288

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