source: git/Singular/iparith.cc @ e5fc00c

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