source: git/Singular/iparith.cc @ b5f5444

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