source: git/Singular/iparith.cc @ e2202ee

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