source: git/Singular/iparith.cc @ a44806

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