source: git/Singular/iparith.cc @ 9c79ef

fieker-DuValspielwiese
Last change on this file since 9c79ef was 9c79ef, checked in by Hans Schoenemann <hannes@…>, 13 years ago
fix overflow handling: jjTIMES_P, jjPOWER_P git-svn-id: file:///usr/local/Singular/svn/trunk@14390 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 206.9 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 <kernel/options.h>
20#include <Singular/ipid.h>
21#include <kernel/intvec.h>
22#include <omalloc/omalloc.h>
23#include <kernel/polys.h>
24#include <kernel/febase.h>
25#include <Singular/sdb.h>
26#include <kernel/longalg.h>
27#include <kernel/longtrans.h>
28#include <kernel/ideals.h>
29#include <kernel/prCopy.h>
30#include <kernel/matpol.h>
31#include <kernel/kstd1.h>
32#include <kernel/timer.h>
33#include <kernel/ring.h>
34#include <Singular/subexpr.h>
35#include <Singular/lists.h>
36#include <kernel/modulop.h>
37#ifdef HAVE_RINGS
38#include <kernel/rmodulon.h>
39#include <kernel/rmodulo2m.h>
40#include <kernel/rintegers.h>
41#endif
42#include <kernel/numbers.h>
43#include <kernel/stairc.h>
44#include <kernel/maps.h>
45#include <Singular/maps_ip.h>
46#include <kernel/syz.h>
47#include <kernel/weight.h>
48#include <Singular/ipconv.h>
49#include <Singular/ipprint.h>
50#include <Singular/attrib.h>
51#include <Singular/silink.h>
52#include <kernel/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 <kernel/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 <kernel/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/gring.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  // now make sure that all matices have the corect size:
1817  matrix T = idModule2formatedMatrix(m,vl,ul);
1818  int i;
1819  if (MATCOLS(U) != ul)
1820  {
1821    int mul=si_min(ul,MATCOLS(U));
1822    matrix UU=mpNew(ul,ul);
1823    int j;
1824    for(i=mul;i>0;i--)
1825    {
1826      for(j=mul;j>0;j--)
1827      {
1828        MATELEM(UU,i,j)=MATELEM(U,i,j);
1829        MATELEM(U,i,j)=NULL;
1830      }
1831    }
1832    idDelete((ideal *)&U);
1833    U=UU;
1834  }
1835  // make sure that U is a diagonal matrix of units
1836  for(i=ul;i>0;i--)
1837  {
1838    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1839  }
1840  lists L=(lists)omAllocBin(slists_bin);
1841  L->Init(3);
1842  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1843  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1844  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1845  res->data=(char *)L;
1846  return FALSE;
1847}
1848static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1849{
1850  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1851  //setFlag(res,FLAG_STD);
1852  return FALSE;
1853}
1854static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1855{
1856  poly p=pOne();
1857  intvec *iv=(intvec*)v->Data();
1858  for(int i=iv->length()-1; i>=0; i--)
1859  {
1860    pSetExp(p,(*iv)[i],1);
1861  }
1862  pSetm(p);
1863  res->data=(char *)idElimination((ideal)u->Data(),p);
1864  pLmDelete(&p);
1865  //setFlag(res,FLAG_STD);
1866  return FALSE;
1867}
1868static BOOLEAN jjEXPORTTO(leftv res, leftv u, leftv v)
1869{
1870  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1871  return iiExport(v,0,(idhdl)u->data);
1872}
1873static BOOLEAN jjERROR(leftv res, leftv u)
1874{
1875  WerrorS((char *)u->Data());
1876  extern int inerror;
1877  inerror=3;
1878  return TRUE;
1879}
1880static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1881{
1882  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1883  int p0=ABS(uu),p1=ABS(vv);
1884  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1885
1886  while ( p1!=0 )
1887  {
1888    q=p0 / p1;
1889    r=p0 % p1;
1890    p0 = p1; p1 = r;
1891    r = g0 - g1 * q;
1892    g0 = g1; g1 = r;
1893    r = f0 - f1 * q;
1894    f0 = f1; f1 = r;
1895  }
1896  int a = f0;
1897  int b = g0;
1898  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
1899  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
1900  lists L=(lists)omAllocBin(slists_bin);
1901  L->Init(3);
1902  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
1903  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
1904  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
1905  res->rtyp=LIST_CMD;
1906  res->data=(char *)L;
1907  return FALSE;
1908}
1909#ifdef HAVE_FACTORY
1910static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
1911{
1912  poly r,pa,pb;
1913  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb);
1914  if (ret) return TRUE;
1915  lists L=(lists)omAllocBin(slists_bin);
1916  L->Init(3);
1917  res->data=(char *)L;
1918  L->m[0].data=(void *)r;
1919  L->m[0].rtyp=POLY_CMD;
1920  L->m[1].data=(void *)pa;
1921  L->m[1].rtyp=POLY_CMD;
1922  L->m[2].data=(void *)pb;
1923  L->m[2].rtyp=POLY_CMD;
1924  return FALSE;
1925}
1926extern int singclap_factorize_retry;
1927static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
1928{
1929  intvec *v=NULL;
1930  int sw=(int)(long)dummy->Data();
1931  int fac_sw=sw;
1932  if ((sw<0)||(sw>2)) fac_sw=1;
1933  singclap_factorize_retry=0;
1934  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw);
1935  if (f==NULL)
1936    return TRUE;
1937  switch(sw)
1938  {
1939    case 0:
1940    case 2:
1941    {
1942      lists l=(lists)omAllocBin(slists_bin);
1943      l->Init(2);
1944      l->m[0].rtyp=IDEAL_CMD;
1945      l->m[0].data=(void *)f;
1946      l->m[1].rtyp=INTVEC_CMD;
1947      l->m[1].data=(void *)v;
1948      res->data=(void *)l;
1949      res->rtyp=LIST_CMD;
1950      return FALSE;
1951    }
1952    case 1:
1953      res->data=(void *)f;
1954      return FALSE;
1955    case 3:
1956      {
1957        poly p=f->m[0];
1958        int i=IDELEMS(f);
1959        f->m[0]=NULL;
1960        while(i>1)
1961        {
1962          i--;
1963          p=pMult(p,f->m[i]);
1964          f->m[i]=NULL;
1965        }
1966        res->data=(void *)p;
1967        res->rtyp=POLY_CMD;
1968      }
1969      return FALSE;
1970  }
1971  WerrorS("invalid switch");
1972  return TRUE;
1973}
1974static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
1975{
1976  ideal_list p,h;
1977  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
1978  p=h;
1979  int l=0;
1980  while (p!=NULL) { p=p->next;l++; }
1981  lists L=(lists)omAllocBin(slists_bin);
1982  L->Init(l);
1983  l=0;
1984  while(h!=NULL)
1985  {
1986    L->m[l].data=(char *)h->d;
1987    L->m[l].rtyp=IDEAL_CMD;
1988    p=h->next;
1989    omFreeSize(h,sizeof(*h));
1990    h=p;
1991    l++;
1992  }
1993  res->data=(void *)L;
1994  return FALSE;
1995}
1996#endif /* HAVE_FACTORY */
1997static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
1998{
1999  if (rField_is_Q())
2000  {
2001    number uu=(number)u->Data();
2002    number vv=(number)v->Data();
2003    res->data=(char *)nlFarey(uu,vv);
2004    return FALSE;
2005  }
2006  else return TRUE;
2007}
2008static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2009{
2010  if (rField_is_Q())
2011  {
2012    ideal uu=(ideal)u->Data();
2013    number vv=(number)v->Data();
2014    res->data=(void*)idFarey(uu,vv);
2015    res->rtyp=u->Typ();
2016    return FALSE;
2017  }
2018  else return TRUE;
2019}
2020static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2021{
2022  ring r=(ring)u->Data();
2023  idhdl w;
2024  int op=iiOp;
2025  nMapFunc nMap;
2026
2027  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2028  {
2029    int *perm=NULL;
2030    int *par_perm=NULL;
2031    int par_perm_size=0;
2032    BOOLEAN bo;
2033    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2034    if ((nMap=nSetMap(r))==NULL)
2035    {
2036      if (rEqual(r,currRing))
2037      {
2038        nMap=nCopy;
2039      }
2040      else
2041      // Allow imap/fetch to be make an exception only for:
2042      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2043            (rField_is_Q() || rField_is_Q_a() ||
2044             (rField_is_Zp() || rField_is_Zp_a())))
2045           ||
2046           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2047            (rField_is_Zp(currRing, rInternalChar(r)) ||
2048             rField_is_Zp_a(currRing, rInternalChar(r)))) )
2049      {
2050        par_perm_size=rPar(r);
2051        BITSET save_test=test;
2052        if ((r->minpoly != NULL) || (r->minideal != NULL))
2053          naSetChar(rInternalChar(r),r);
2054        else ntSetChar(rInternalChar(r),r);
2055        nSetChar(currRing);
2056        test=save_test;
2057      }
2058      else
2059      {
2060        goto err_fetch;
2061      }
2062    }
2063    if ((iiOp!=FETCH_CMD) || (r->N!=pVariables) || (rPar(r)!=rPar(currRing)))
2064    {
2065      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2066      if (par_perm_size!=0)
2067        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2068      op=IMAP_CMD;
2069      if (iiOp==IMAP_CMD)
2070      {
2071        maFindPerm(r->names,       r->N,       r->parameter,        r->P,
2072                   currRing->names,currRing->N,currRing->parameter, currRing->P,
2073                   perm,par_perm, currRing->ch);
2074      }
2075      else
2076      {
2077        int i;
2078        if (par_perm_size!=0)
2079          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2080        for(i=si_min(r->N,pVariables);i>0;i--) perm[i]=i;
2081      }
2082    }
2083    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2084    {
2085      int i;
2086      for(i=0;i<si_min(r->N,pVariables);i++)
2087      {
2088        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2089      }
2090      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2091      {
2092        Print("// par nr %d: %s -> %s\n",
2093              i,r->parameter[i],currRing->parameter[i]);
2094      }
2095    }
2096    sleftv tmpW;
2097    memset(&tmpW,0,sizeof(sleftv));
2098    tmpW.rtyp=IDTYP(w);
2099    tmpW.data=IDDATA(w);
2100    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2101                         perm,par_perm,par_perm_size,nMap)))
2102    {
2103      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2104    }
2105    if (perm!=NULL)
2106      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2107    if (par_perm!=NULL)
2108      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2109    return bo;
2110  }
2111  else
2112  {
2113    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2114  }
2115  return TRUE;
2116err_fetch:
2117  Werror("no identity map from %s",u->Fullname());
2118  return TRUE;
2119}
2120static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2121{
2122  /*4
2123  * look for the substring what in the string where
2124  * return the position of the first char of what in where
2125  * or 0
2126  */
2127  char *where=(char *)u->Data();
2128  char *what=(char *)v->Data();
2129  char *found = strstr(where,what);
2130  if (found != NULL)
2131  {
2132    res->data=(char *)((found-where)+1);
2133  }
2134  /*else res->data=NULL;*/
2135  return FALSE;
2136}
2137static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2138{
2139  res->data=(char *)fractalWalkProc(u,v);
2140  setFlag( res, FLAG_STD );
2141  return FALSE;
2142}
2143static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2144{
2145  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2146  int p0=ABS(uu),p1=ABS(vv);
2147  int r;
2148  while ( p1!=0 )
2149  {
2150    r=p0 % p1;
2151    p0 = p1; p1 = r;
2152  }
2153  res->rtyp=INT_CMD;
2154  res->data=(char *)(long)p0;
2155  return FALSE;
2156}
2157static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2158{
2159  number a=(number) u->Data();
2160  number b=(number) v->Data();
2161  if (nlIsZero(a))
2162  {
2163    if (nlIsZero(b)) res->data=(char *)nlInit(1, NULL);
2164    else             res->data=(char *)nlCopy(b);
2165  }
2166  else
2167  {
2168    if (nlIsZero(b))  res->data=(char *)nlCopy(a);
2169    else res->data=(char *)nlGcd(a, b, NULL);
2170  }
2171  return FALSE;
2172}
2173static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2174{
2175  number a=(number) u->Data();
2176  number b=(number) v->Data();
2177  if (nIsZero(a))
2178  {
2179    if (nIsZero(b)) res->data=(char *)nInit(1);
2180    else            res->data=(char *)nCopy(b);
2181  }
2182  else
2183  {
2184    if (nIsZero(b))  res->data=(char *)nCopy(a);
2185    else res->data=(char *)nGcd(a, b, currRing);
2186  }
2187  return FALSE;
2188}
2189#ifdef HAVE_FACTORY
2190static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2191{
2192  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2193                                 (poly)(v->CopyD(POLY_CMD)));
2194  return FALSE;
2195}
2196#endif /* HAVE_FACTORY */
2197static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2198{
2199#ifdef HAVE_RINGS
2200  if (rField_is_Ring_Z(currRing))
2201  {
2202    ring origR = currRing;
2203    ring tempR = rCopy(origR);
2204    tempR->ringtype = 0; tempR->ch = 0;
2205    rComplete(tempR);
2206    ideal uid = (ideal)u->Data();
2207    rChangeCurrRing(tempR);
2208    ideal uu = idrCopyR(uid, origR, currRing);
2209    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2210    uuAsLeftv.rtyp = IDEAL_CMD;
2211    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2212    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2213    assumeStdFlag(&uuAsLeftv);
2214    Print("// NOTE: computation of Hilbert series etc. is being\n");
2215    Print("//       performed for generic fibre, that is, over Q\n");
2216    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2217    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2218    int returnWithTrue = 1;
2219    switch((int)(long)v->Data())
2220    {
2221      case 1:
2222        res->data=(void *)iv;
2223        returnWithTrue = 0;
2224      case 2:
2225        res->data=(void *)hSecondSeries(iv);
2226        delete iv;
2227        returnWithTrue = 0;
2228    }
2229    if (returnWithTrue)
2230    {
2231      WerrorS(feNotImplemented);
2232      delete iv;
2233    }
2234    idDelete(&uu);
2235    rChangeCurrRing(origR);
2236    rDelete(tempR);
2237    if (returnWithTrue) return TRUE; else return FALSE;
2238  }
2239#endif
2240  assumeStdFlag(u);
2241  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2242  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2243  switch((int)(long)v->Data())
2244  {
2245    case 1:
2246      res->data=(void *)iv;
2247      return FALSE;
2248    case 2:
2249      res->data=(void *)hSecondSeries(iv);
2250      delete iv;
2251      return FALSE;
2252  }
2253  WerrorS(feNotImplemented);
2254  delete iv;
2255  return TRUE;
2256}
2257static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2258{
2259  int i=pVar((poly)v->Data());
2260  if (i==0)
2261  {
2262    WerrorS("ringvar expected");
2263    return TRUE;
2264  }
2265  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2266  int d=pWTotaldegree(p);
2267  pLmDelete(p);
2268  if (d==1)
2269    res->data = (char *)pHomogen((poly)u->Data(),i);
2270  else
2271    WerrorS("variable must have weight 1");
2272  return (d!=1);
2273}
2274static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2275{
2276  int i=pVar((poly)v->Data());
2277  if (i==0)
2278  {
2279    WerrorS("ringvar expected");
2280    return TRUE;
2281  }
2282  pFDegProc deg;
2283  if (pLexOrder && (currRing->order[0]==ringorder_lp))
2284    deg=p_Totaldegree;
2285   else
2286    deg=pFDeg;
2287  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2288  int d=deg(p,currRing);
2289  pLmDelete(p);
2290  if (d==1)
2291    res->data = (char *)idHomogen((ideal)u->Data(),i);
2292  else
2293    WerrorS("variable must have weight 1");
2294  return (d!=1);
2295}
2296static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2297{
2298  intvec *w=new intvec(rVar(currRing));
2299  intvec *vw=(intvec*)u->Data();
2300  ideal v_id=(ideal)v->Data();
2301  pFDegProc save_FDeg=pFDeg;
2302  pLDegProc save_LDeg=pLDeg;
2303  BOOLEAN save_pLexOrder=pLexOrder;
2304  pLexOrder=FALSE;
2305  kHomW=vw;
2306  kModW=w;
2307  pSetDegProcs(kHomModDeg);
2308  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2309  pLexOrder=save_pLexOrder;
2310  kHomW=NULL;
2311  kModW=NULL;
2312  pRestoreDegProcs(save_FDeg,save_LDeg);
2313  if (w!=NULL) delete w;
2314  return FALSE;
2315}
2316static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2317{
2318  assumeStdFlag(u);
2319  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2320                    currQuotient);
2321  return FALSE;
2322}
2323static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2324{
2325  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2326  setFlag(res,FLAG_STD);
2327  return FALSE;
2328}
2329static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2330{
2331  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2332}
2333static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2334{
2335  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2336  return FALSE;
2337}
2338static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2339{
2340  res->data = (char *)idJet((ideal)u->Data(),(int)(long)v->Data());
2341  return FALSE;
2342}
2343static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2344{
2345  assumeStdFlag(u);
2346  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2347  res->data = (char *)scKBase((int)(long)v->Data(),
2348                              (ideal)(u->Data()),currQuotient, w_u);
2349  if (w_u!=NULL)
2350  {
2351    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2352  }
2353  return FALSE;
2354}
2355static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2356static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2357{
2358  return jjPREIMAGE(res,u,v,NULL);
2359}
2360static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2361{
2362  return mpKoszul(res, u,v);
2363}
2364static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2365{
2366  sleftv h;
2367  memset(&h,0,sizeof(sleftv));
2368  h.rtyp=INT_CMD;
2369  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2370  return mpKoszul(res, u, &h, v);
2371}
2372static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2373{
2374  ideal m;
2375  BITSET save_test=test;
2376  int ul= IDELEMS((ideal)u->Data());
2377  int vl= IDELEMS((ideal)v->Data());
2378  m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD));
2379  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
2380  test=save_test;
2381  return FALSE;
2382}
2383static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2384{
2385  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2386  idhdl h=(idhdl)v->data;
2387  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2388  res->data = (char *)idLiftStd((ideal)u->Data(),
2389                                &(h->data.umatrix),testHomog);
2390  setFlag(res,FLAG_STD); v->flag=0;
2391  return FALSE;
2392}
2393static BOOLEAN jjLOAD2(leftv res, leftv u,leftv v)
2394{
2395  return jjLOAD(res, v,TRUE);
2396}
2397static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2398{
2399  char * s=(char *)u->Data();
2400  if(strcmp(s, "with")==0)
2401    return jjLOAD(res, v, TRUE);
2402  WerrorS("invalid second argument");
2403  WerrorS("load(\"libname\" [,\"with\"]);");
2404  return TRUE;
2405}
2406static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2407{
2408  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2409  tHomog hom=testHomog;
2410  if (w_u!=NULL)
2411  {
2412    w_u=ivCopy(w_u);
2413    hom=isHomog;
2414  }
2415  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2416  if (w_v!=NULL)
2417  {
2418    w_v=ivCopy(w_v);
2419    hom=isHomog;
2420  }
2421  if ((w_u!=NULL) && (w_v==NULL))
2422    w_v=ivCopy(w_u);
2423  if ((w_v!=NULL) && (w_u==NULL))
2424    w_u=ivCopy(w_v);
2425  ideal u_id=(ideal)u->Data();
2426  ideal v_id=(ideal)v->Data();
2427  if (w_u!=NULL)
2428  {
2429     if ((*w_u).compare((w_v))!=0)
2430     {
2431       WarnS("incompatible weights");
2432       delete w_u; w_u=NULL;
2433       hom=testHomog;
2434     }
2435     else
2436     {
2437       if ((!idTestHomModule(u_id,currQuotient,w_v))
2438       || (!idTestHomModule(v_id,currQuotient,w_v)))
2439       {
2440         WarnS("wrong weights");
2441         delete w_u; w_u=NULL;
2442         hom=testHomog;
2443       }
2444     }
2445  }
2446  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2447  if (w_u!=NULL)
2448  {
2449    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2450  }
2451  delete w_v;
2452  return FALSE;
2453}
2454static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2455{
2456  number q=(number)v->Data();
2457  if (nlIsZero(q))
2458  {
2459    WerrorS(ii_div_by_0);
2460    return TRUE;
2461  }
2462  res->data =(char *) nlIntMod((number)u->Data(),q);
2463  return FALSE;
2464}
2465static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2466{
2467  number q=(number)v->Data();
2468  if (nIsZero(q))
2469  {
2470    WerrorS(ii_div_by_0);
2471    return TRUE;
2472  }
2473  res->data =(char *) nIntMod((number)u->Data(),q);
2474  return FALSE;
2475}
2476static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2477static BOOLEAN jjMONITOR1(leftv res, leftv v)
2478{
2479  return jjMONITOR2(res,v,NULL);
2480}
2481static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v)
2482{
2483#if 0
2484  char *opt=(char *)v->Data();
2485  int mode=0;
2486  while(*opt!='\0')
2487  {
2488    if (*opt=='i') mode |= PROT_I;
2489    else if (*opt=='o') mode |= PROT_O;
2490    opt++;
2491  }
2492  monitor((char *)(u->Data()),mode);
2493#else
2494  si_link l=(si_link)u->Data();
2495  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2496  if(strcmp(l->m->type,"ASCII")!=0)
2497  {
2498    Werror("ASCII link required, not `%s`",l->m->type);
2499    slClose(l);
2500    return TRUE;
2501  }
2502  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2503  if ( l->name[0]!='\0') // "" is the stop condition
2504  {
2505    const char *opt;
2506    int mode=0;
2507    if (v==NULL) opt=(const char*)"i";
2508    else         opt=(const char *)v->Data();
2509    while(*opt!='\0')
2510    {
2511      if (*opt=='i') mode |= PROT_I;
2512      else if (*opt=='o') mode |= PROT_O;
2513      opt++;
2514    }
2515    monitor((FILE *)l->data,mode);
2516  }
2517  else
2518    monitor(NULL,0);
2519  return FALSE;
2520#endif
2521}
2522static BOOLEAN jjMONOM(leftv res, leftv v)
2523{
2524  intvec *iv=(intvec *)v->Data();
2525  poly p=pOne();
2526  int i,e;
2527  BOOLEAN err=FALSE;
2528  for(i=si_min(pVariables,iv->length()); i>0; i--)
2529  {
2530    e=(*iv)[i-1];
2531    if (e>=0) pSetExp(p,i,e);
2532    else err=TRUE;
2533  }
2534  if (iv->length()==(pVariables+1))
2535  {
2536    res->rtyp=VECTOR_CMD;
2537    e=(*iv)[pVariables];
2538    if (e>=0) pSetComp(p,e);
2539    else err=TRUE;
2540  }
2541  pSetm(p);
2542  res->data=(char*)p;
2543  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2544  return err;
2545}
2546static BOOLEAN jjNEWSTRUCT2(leftv res, leftv u, leftv v)
2547{
2548  // u: the name of the new type
2549  // v: the elements
2550  newstruct_desc d=newstructFromString((const char *)v->Data());
2551  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2552  return d==NULL;
2553}
2554static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2555{
2556  idhdl h=(idhdl)u->data;
2557  int i=(int)(long)v->Data();
2558  int p=0;
2559  if ((0<i)
2560  && (IDRING(h)->parameter!=NULL)
2561  && (i<=(p=rPar(IDRING(h)))))
2562    res->data=omStrDup(IDRING(h)->parameter[i-1]);
2563  else
2564  {
2565    Werror("par number %d out of range 1..%d",i,p);
2566    return TRUE;
2567  }
2568  return FALSE;
2569}
2570#ifdef HAVE_PLURAL
2571static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2572{
2573  if( currRing->qideal != NULL )
2574  {
2575    WerrorS("basering must NOT be a qring!");
2576    return TRUE;
2577  }
2578
2579  if (iiOp==NCALGEBRA_CMD)
2580  {
2581    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing);
2582  }
2583  else
2584  {
2585    ring r=rCopy(currRing);
2586    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r);
2587    res->data=r;
2588    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2589    return result;
2590  }
2591}
2592static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2593{
2594  if( currRing->qideal != NULL )
2595  {
2596    WerrorS("basering must NOT be a qring!");
2597    return TRUE;
2598  }
2599
2600  if (iiOp==NCALGEBRA_CMD)
2601  {
2602    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing);
2603  }
2604  else
2605  {
2606    ring r=rCopy(currRing);
2607    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r);
2608    res->data=r;
2609    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2610    return result;
2611  }
2612}
2613static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2614{
2615  if( currRing->qideal != NULL )
2616  {
2617    WerrorS("basering must NOT be a qring!");
2618    return TRUE;
2619  }
2620
2621  if (iiOp==NCALGEBRA_CMD)
2622  {
2623    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing);
2624  }
2625  else
2626  {
2627    ring r=rCopy(currRing);
2628    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r);
2629    res->data=r;
2630    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2631    return result;
2632  }
2633}
2634static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2635{
2636  if( currRing->qideal != NULL )
2637  {
2638    WerrorS("basering must NOT be a qring!");
2639    return TRUE;
2640  }
2641
2642  if (iiOp==NCALGEBRA_CMD)
2643  {
2644    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing);
2645  }
2646  else
2647  {
2648    ring r=rCopy(currRing);
2649    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r);
2650    res->data=r;
2651    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2652    return result;
2653  }
2654}
2655static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2656{
2657  res->data=NULL;
2658
2659  if (rIsPluralRing(currRing))
2660  {
2661    const poly q = (poly)b->Data();
2662
2663    if( q != NULL )
2664    {
2665      if( (poly)a->Data() != NULL )
2666      {
2667        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2668        res->data = nc_p_Bracket_qq(p,q); // p will be destroyed!
2669      }
2670    }
2671  }
2672  return FALSE;
2673}
2674static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2675{
2676  /* number, poly, vector, ideal, module, matrix */
2677  ring  r = (ring)a->Data();
2678  if (r == currRing)
2679  {
2680    res->data = b->Data();
2681    res->rtyp = b->rtyp;
2682    return FALSE;
2683  }
2684  if (!rIsLikeOpposite(currRing, r))
2685  {
2686    Werror("%s is not an opposite ring to current ring",a->Fullname());
2687    return TRUE;
2688  }
2689  idhdl w;
2690  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2691  {
2692    int argtype = IDTYP(w);
2693    switch (argtype)
2694    {
2695    case NUMBER_CMD:
2696      {
2697        /* since basefields are equal, we can apply nCopy */
2698        res->data = nCopy((number)IDDATA(w));
2699        res->rtyp = argtype;
2700        break;
2701      }
2702    case POLY_CMD:
2703    case VECTOR_CMD:
2704      {
2705        poly    q = (poly)IDDATA(w);
2706        res->data = pOppose(r,q);
2707        res->rtyp = argtype;
2708        break;
2709      }
2710    case IDEAL_CMD:
2711    case MODUL_CMD:
2712      {
2713        ideal   Q = (ideal)IDDATA(w);
2714        res->data = idOppose(r,Q);
2715        res->rtyp = argtype;
2716        break;
2717      }
2718    case MATRIX_CMD:
2719      {
2720        ring save = currRing;
2721        rChangeCurrRing(r);
2722        matrix  m = (matrix)IDDATA(w);
2723        ideal   Q = idMatrix2Module(mpCopy(m));
2724        rChangeCurrRing(save);
2725        ideal   S = idOppose(r,Q);
2726        id_Delete(&Q, r);
2727        res->data = idModule2Matrix(S);
2728        res->rtyp = argtype;
2729        break;
2730      }
2731    default:
2732      {
2733        WerrorS("unsupported type in oppose");
2734        return TRUE;
2735      }
2736    }
2737  }
2738  else
2739  {
2740    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2741    return TRUE;
2742  }
2743  return FALSE;
2744}
2745#endif /* HAVE_PLURAL */
2746
2747static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2748{
2749  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2750    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2751  idDelMultiples((ideal)(res->data));
2752  return FALSE;
2753}
2754static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2755{
2756  int i=(int)(long)u->Data();
2757  int j=(int)(long)v->Data();
2758  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2759  return FALSE;
2760}
2761static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2762{
2763  matrix m =(matrix)u->Data();
2764  int isRowEchelon = (int)(long)v->Data();
2765  if (isRowEchelon != 1) isRowEchelon = 0;
2766  int rank = luRank(m, isRowEchelon);
2767  res->data =(char *)(long)rank;
2768  return FALSE;
2769}
2770static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2771{
2772  si_link l=(si_link)u->Data();
2773  leftv r=slRead(l,v);
2774  if (r==NULL)
2775  {
2776    const char *s;
2777    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2778    else                            s=sNoName;
2779    Werror("cannot read from `%s`",s);
2780    return TRUE;
2781  }
2782  memcpy(res,r,sizeof(sleftv));
2783  omFreeBin((ADDRESS)r, sleftv_bin);
2784  return FALSE;
2785}
2786static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2787{
2788  assumeStdFlag(v);
2789  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2790  return FALSE;
2791}
2792static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2793{
2794  assumeStdFlag(v);
2795  ideal ui=(ideal)u->Data();
2796  idTest(ui);
2797  ideal vi=(ideal)v->Data();
2798  idTest(vi);
2799  res->data = (char *)kNF(vi,currQuotient,ui);
2800  return FALSE;
2801}
2802#if 0
2803static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2804{
2805  int maxl=(int)(long)v->Data();
2806  if (maxl<0)
2807  {
2808    WerrorS("length for res must not be negative");
2809    return TRUE;
2810  }
2811  int l=0;
2812  //resolvente r;
2813  syStrategy r;
2814  intvec *weights=NULL;
2815  int wmaxl=maxl;
2816  ideal u_id=(ideal)u->Data();
2817
2818  maxl--;
2819  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2820  {
2821    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2822    if (currQuotient!=NULL)
2823    {
2824      Warn(
2825      "full resolution in a qring may be infinite, setting max length to %d",
2826      maxl+1);
2827    }
2828  }
2829  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2830  if (weights!=NULL)
2831  {
2832    if (!idTestHomModule(u_id,currQuotient,weights))
2833    {
2834      WarnS("wrong weights given:");weights->show();PrintLn();
2835      weights=NULL;
2836    }
2837  }
2838  intvec *ww=NULL;
2839  int add_row_shift=0;
2840  if (weights!=NULL)
2841  {
2842     ww=ivCopy(weights);
2843     add_row_shift = ww->min_in();
2844     (*ww) -= add_row_shift;
2845  }
2846  else
2847    idHomModule(u_id,currQuotient,&ww);
2848  weights=ww;
2849
2850  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2851  {
2852    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2853  }
2854  else if (iiOp==SRES_CMD)
2855  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2856    r=sySchreyer(u_id,maxl+1);
2857  else if (iiOp == LRES_CMD)
2858  {
2859    int dummy;
2860    if((currQuotient!=NULL)||
2861    (!idHomIdeal (u_id,NULL)))
2862    {
2863       WerrorS
2864       ("`lres` not implemented for inhomogeneous input or qring");
2865       return TRUE;
2866    }
2867    r=syLaScala3(u_id,&dummy);
2868  }
2869  else if (iiOp == KRES_CMD)
2870  {
2871    int dummy;
2872    if((currQuotient!=NULL)||
2873    (!idHomIdeal (u_id,NULL)))
2874    {
2875       WerrorS
2876       ("`kres` not implemented for inhomogeneous input or qring");
2877       return TRUE;
2878    }
2879    r=syKosz(u_id,&dummy);
2880  }
2881  else
2882  {
2883    int dummy;
2884    if((currQuotient!=NULL)||
2885    (!idHomIdeal (u_id,NULL)))
2886    {
2887       WerrorS
2888       ("`hres` not implemented for inhomogeneous input or qring");
2889       return TRUE;
2890    }
2891    r=syHilb(u_id,&dummy);
2892  }
2893  if (r==NULL) return TRUE;
2894  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2895  r->list_length=wmaxl;
2896  res->data=(void *)r;
2897  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2898  {
2899    intvec *w=ivCopy(r->weights[0]);
2900    if (weights!=NULL) (*w) += add_row_shift;
2901    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
2902    w=NULL;
2903  }
2904  else
2905  {
2906//#if 0
2907// need to set weights for ALL components (sres)
2908    if (weights!=NULL)
2909    {
2910      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2911      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
2912      (r->weights)[0] = ivCopy(weights);
2913    }
2914//#endif
2915  }
2916  if (ww!=NULL) { delete ww; ww=NULL; }
2917  return FALSE;
2918}
2919#else
2920static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2921{
2922  int maxl=(int)(long)v->Data();
2923  if (maxl<0)
2924  {
2925    WerrorS("length for res must not be negative");
2926    return TRUE;
2927  }
2928  int l=0;
2929  //resolvente r;
2930  syStrategy r;
2931  intvec *weights=NULL;
2932  int wmaxl=maxl;
2933  ideal u_id=(ideal)u->Data();
2934
2935  maxl--;
2936  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2937  {
2938    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2939    if (currQuotient!=NULL)
2940    {
2941      Warn(
2942      "full resolution in a qring may be infinite, setting max length to %d",
2943      maxl+1);
2944    }
2945  }
2946  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2947  if (weights!=NULL)
2948  {
2949    if (!idTestHomModule(u_id,currQuotient,weights))
2950    {
2951      WarnS("wrong weights given:");weights->show();PrintLn();
2952      weights=NULL;
2953    }
2954  }
2955  intvec *ww=NULL;
2956  int add_row_shift=0;
2957  if (weights!=NULL)
2958  {
2959     ww=ivCopy(weights);
2960     add_row_shift = ww->min_in();
2961     (*ww) -= add_row_shift;
2962  }
2963  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2964  {
2965    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2966  }
2967  else if (iiOp==SRES_CMD)
2968  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2969    r=sySchreyer(u_id,maxl+1);
2970  else if (iiOp == LRES_CMD)
2971  {
2972    int dummy;
2973    if((currQuotient!=NULL)||
2974    (!idHomIdeal (u_id,NULL)))
2975    {
2976       WerrorS
2977       ("`lres` not implemented for inhomogeneous input or qring");
2978       return TRUE;
2979    }
2980    if(currRing->N == 1)
2981      WarnS("the current implementation of `lres` may not work in the case of a single variable");
2982    r=syLaScala3(u_id,&dummy);
2983  }
2984  else if (iiOp == KRES_CMD)
2985  {
2986    int dummy;
2987    if((currQuotient!=NULL)||
2988    (!idHomIdeal (u_id,NULL)))
2989    {
2990       WerrorS
2991       ("`kres` not implemented for inhomogeneous input or qring");
2992       return TRUE;
2993    }
2994    r=syKosz(u_id,&dummy);
2995  }
2996  else
2997  {
2998    int dummy;
2999    if((currQuotient!=NULL)||
3000    (!idHomIdeal (u_id,NULL)))
3001    {
3002       WerrorS
3003       ("`hres` not implemented for inhomogeneous input or qring");
3004       return TRUE;
3005    }
3006    ideal u_id_copy=idCopy(u_id);
3007    idSkipZeroes(u_id_copy);
3008    r=syHilb(u_id_copy,&dummy);
3009    idDelete(&u_id_copy);
3010  }
3011  if (r==NULL) return TRUE;
3012  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3013  r->list_length=wmaxl;
3014  res->data=(void *)r;
3015  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3016  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3017  {
3018    ww=ivCopy(r->weights[0]);
3019    if (weights!=NULL) (*ww) += add_row_shift;
3020    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3021  }
3022  else
3023  {
3024    if (weights!=NULL)
3025    {
3026      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3027    }
3028  }
3029
3030  // test the La Scala case' output
3031  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3032  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3033
3034  if(iiOp != HRES_CMD)
3035    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3036  else
3037    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3038
3039  return FALSE;
3040}
3041#endif
3042static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3043{
3044  number n1; number n2; number temp; int i;
3045
3046  if ((u->Typ() == BIGINT_CMD) ||
3047     ((u->Typ() == NUMBER_CMD) && rField_is_Q()))
3048  {
3049    temp = (number)u->Data();
3050    n1 = nlCopy(temp);
3051  }
3052  else if (u->Typ() == INT_CMD)
3053  {
3054    i = (int)(long)u->Data();
3055    n1 = nlInit(i, NULL);
3056  }
3057  else
3058  {
3059    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3060    return TRUE;
3061  }
3062
3063  if ((v->Typ() == BIGINT_CMD) ||
3064     ((v->Typ() == NUMBER_CMD) && rField_is_Q()))
3065  {
3066    temp = (number)v->Data();
3067    n2 = nlCopy(temp);
3068  }
3069  else if (v->Typ() == INT_CMD)
3070  {
3071    i = (int)(long)v->Data();
3072    n2 = nlInit(i, NULL);
3073  }
3074  else
3075  {
3076    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3077    return TRUE;
3078  }
3079
3080  lists l = primeFactorisation(n1, n2);
3081  nlDelete(&n1, NULL); nlDelete(&n2, NULL);
3082  res->data = (char*)l;
3083  return FALSE;
3084}
3085static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3086{
3087  ring r;
3088  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3089  res->data = (char *)r;
3090  return (i==-1);
3091}
3092#define SIMPL_LMDIV 32
3093#define SIMPL_LMEQ  16
3094#define SIMPL_MULT 8
3095#define SIMPL_EQU  4
3096#define SIMPL_NULL 2
3097#define SIMPL_NORM 1
3098static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3099{
3100  int sw = (int)(long)v->Data();
3101  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3102  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3103  if (sw & SIMPL_LMDIV)
3104  {
3105    idDelDiv(id);
3106  }
3107  if (sw & SIMPL_LMEQ)
3108  {
3109    idDelLmEquals(id);
3110  }
3111  if (sw & SIMPL_MULT)
3112  {
3113    idDelMultiples(id);
3114  }
3115  else if(sw & SIMPL_EQU)
3116  {
3117    idDelEquals(id);
3118  }
3119  if (sw & SIMPL_NULL)
3120  {
3121    idSkipZeroes(id);
3122  }
3123  if (sw & SIMPL_NORM)
3124  {
3125    idNorm(id);
3126  }
3127  res->data = (char * )id;
3128  return FALSE;
3129}
3130static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3131{
3132  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3133  return FALSE;
3134}
3135static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3136{
3137  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3138  //return (res->data== (void*)(long)-2);
3139  return FALSE;
3140}
3141static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3142{
3143  int sw = (int)(long)v->Data();
3144  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3145  poly p = (poly)u->CopyD(POLY_CMD);
3146  if (sw & SIMPL_NORM)
3147  {
3148    pNorm(p);
3149  }
3150  res->data = (char * )p;
3151  return FALSE;
3152}
3153static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3154{
3155  ideal result;
3156  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3157  tHomog hom=testHomog;
3158  ideal u_id=(ideal)(u->Data());
3159  if (w!=NULL)
3160  {
3161    if (!idTestHomModule(u_id,currQuotient,w))
3162    {
3163      WarnS("wrong weights:");w->show();PrintLn();
3164      w=NULL;
3165    }
3166    else
3167    {
3168      w=ivCopy(w);
3169      hom=isHomog;
3170    }
3171  }
3172  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3173  idSkipZeroes(result);
3174  res->data = (char *)result;
3175  setFlag(res,FLAG_STD);
3176  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3177  return FALSE;
3178}
3179static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3180static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3181/* destroys i0, p0 */
3182/* result (with attributes) in res */
3183/* i0: SB*/
3184/* t0: type of p0*/
3185/* p0 new elements*/
3186/* a attributes of i0*/
3187{
3188  int tp;
3189  if (t0==IDEAL_CMD) tp=POLY_CMD;
3190  else               tp=VECTOR_CMD;
3191  for (int i=IDELEMS(p0)-1; i>=0; i--)
3192  {
3193    poly p=p0->m[i];
3194    p0->m[i]=NULL;
3195    if (p!=NULL)
3196    {
3197      sleftv u0,v0;
3198      memset(&u0,0,sizeof(sleftv));
3199      memset(&v0,0,sizeof(sleftv));
3200      v0.rtyp=tp;
3201      v0.data=(void*)p;
3202      u0.rtyp=t0;
3203      u0.data=i0;
3204      u0.attribute=a;
3205      setFlag(&u0,FLAG_STD);
3206      jjSTD_1(res,&u0,&v0);
3207      i0=(ideal)res->data;
3208      res->data=NULL;
3209      a=res->attribute;
3210      res->attribute=NULL;
3211      u0.CleanUp();
3212      v0.CleanUp();
3213      res->CleanUp();
3214    }
3215  }
3216  idDelete(&p0);
3217  res->attribute=a;
3218  res->data=(void *)i0;
3219  res->rtyp=t0;
3220}
3221static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3222{
3223  ideal result;
3224  assumeStdFlag(u);
3225  ideal i1=(ideal)(u->Data());
3226  ideal i0;
3227  int r=v->Typ();
3228  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3229  {
3230    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3231    i0->m[0]=(poly)v->Data();
3232    int ii0=idElem(i0); /* size of i0 */
3233    i1=idSimpleAdd(i1,i0); //
3234    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3235    idDelete(&i0);
3236    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3237    tHomog hom=testHomog;
3238
3239    if (w!=NULL)
3240    {
3241      if (!idTestHomModule(i1,currQuotient,w))
3242      {
3243        // no warnung: this is legal, if i in std(i,p)
3244        // is homogeneous, but p not
3245        w=NULL;
3246      }
3247      else
3248      {
3249        w=ivCopy(w);
3250        hom=isHomog;
3251      }
3252    }
3253    BITSET save_test=test;
3254    test|=Sy_bit(OPT_SB_1);
3255    /* ii0 appears to be the position of the first element of il that
3256       does not belong to the old SB ideal */
3257    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3258    test=save_test;
3259    idDelete(&i1);
3260    idSkipZeroes(result);
3261    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3262    res->data = (char *)result;
3263  }
3264  else /*IDEAL/MODULE*/
3265  {
3266    attr *aa=u->Attribute();
3267    attr a=NULL;
3268    if (aa!=NULL) a=(*aa)->Copy();
3269    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3270  }
3271  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3272  return FALSE;
3273}
3274static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3275{
3276  idhdl h=(idhdl)u->data;
3277  int i=(int)(long)v->Data();
3278  if ((0<i) && (i<=IDRING(h)->N))
3279    res->data=omStrDup(IDRING(h)->names[i-1]);
3280  else
3281  {
3282    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3283    return TRUE;
3284  }
3285  return FALSE;
3286}
3287static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3288{
3289// input: u: a list with links of type
3290//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3291//        v: timeout for select in milliseconds
3292//           or 0 for polling
3293// returns: ERROR (via Werror): timeout negative
3294//           -1: the read state of all links is eof
3295//            0: timeout (or polling): none ready
3296//           i>0: (at least) L[i] is ready
3297  lists Lforks = (lists)u->Data();
3298  int t = (int)(long)v->Data();
3299  if(t < 0)
3300  {
3301    WerrorS("negative timeout"); return TRUE;
3302  }
3303  int i = slStatusSsiL(Lforks, t*1000);
3304  if(i == -2) /* error */
3305  {
3306    return TRUE;
3307  }
3308  res->data = (void*)(long)i;
3309  return FALSE;
3310}
3311static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3312{
3313// input: u: a list with links of type
3314//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3315//        v: timeout for select in milliseconds
3316//           or 0 for polling
3317// returns: ERROR (via Werror): timeout negative
3318//           -1: the read state of all links is eof
3319//           0: timeout (or polling): none ready
3320//           1: all links are ready
3321//              (caution: at least one is ready, but some maybe dead)
3322  lists Lforks = (lists)u->CopyD();
3323  int timeout = 1000*(int)(long)v->Data();
3324  if(timeout < 0)
3325  {
3326    WerrorS("negative timeout"); return TRUE;
3327  }
3328  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3329  int i;
3330  int ret = -1;
3331  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3332  {
3333    i = slStatusSsiL(Lforks, timeout);
3334    if(i > 0) /* Lforks[i] is ready */
3335    {
3336      ret = 1;
3337      Lforks->m[i-1].CleanUp();
3338      Lforks->m[i-1].rtyp=DEF_CMD;
3339      Lforks->m[i-1].data=NULL;
3340      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3341    }
3342    else /* terminate the for loop */
3343    {
3344      if(i == -2) /* error */
3345      {
3346        return TRUE;
3347      }
3348      if(i == 0) /* timeout */
3349      {
3350        ret = 0;
3351      }
3352      break;
3353    }
3354  }
3355  Lforks->Clean();
3356  res->data = (void*)(long)ret;
3357  return FALSE;
3358}
3359static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3360{
3361  res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
3362  return FALSE;
3363}
3364#define jjWRONG2 (proc2)jjWRONG
3365#define jjWRONG3 (proc3)jjWRONG
3366static BOOLEAN jjWRONG(leftv res, leftv u)
3367{
3368  return TRUE;
3369}
3370
3371/*=================== operations with 1 arg.: static proc =================*/
3372/* must be ordered: first operations for chars (infix ops),
3373 * then alphabetically */
3374
3375static BOOLEAN jjDUMMY(leftv res, leftv u)
3376{
3377  res->data = (char *)u->CopyD();
3378  return FALSE;
3379}
3380static BOOLEAN jjNULL(leftv res, leftv u)
3381{
3382  return FALSE;
3383}
3384//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3385//{
3386//  res->data = (char *)((int)(long)u->Data()+1);
3387//  return FALSE;
3388//}
3389//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3390//{
3391//  res->data = (char *)((int)(long)u->Data()-1);
3392//  return FALSE;
3393//}
3394static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3395{
3396  if (IDTYP((idhdl)u->data)==INT_CMD)
3397  {
3398    int i=IDINT((idhdl)u->data);
3399    if (iiOp==PLUSPLUS) i++;
3400    else                i--;
3401    IDDATA((idhdl)u->data)=(char *)(long)i;
3402    return FALSE;
3403  }
3404  return TRUE;
3405}
3406static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3407{
3408  number n=(number)u->CopyD(BIGINT_CMD);
3409  n=nlNeg(n);
3410  res->data = (char *)n;
3411  return FALSE;
3412}
3413static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3414{
3415  res->data = (char *)(-(long)u->Data());
3416  return FALSE;
3417}
3418static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3419{
3420  number n=(number)u->CopyD(NUMBER_CMD);
3421  n=nNeg(n);
3422  res->data = (char *)n;
3423  return FALSE;
3424}
3425static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3426{
3427  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3428  return FALSE;
3429}
3430static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3431{
3432  poly m1=pISet(-1);
3433  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
3434  return FALSE;
3435}
3436static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3437{
3438  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3439  (*iv)*=(-1);
3440  res->data = (char *)iv;
3441  return FALSE;
3442}
3443static BOOLEAN jjPROC1(leftv res, leftv u)
3444{
3445  return jjPROC(res,u,NULL);
3446}
3447static BOOLEAN jjBAREISS(leftv res, leftv v)
3448{
3449  //matrix m=(matrix)v->Data();
3450  //lists l=mpBareiss(m,FALSE);
3451  intvec *iv;
3452  ideal m;
3453  smCallBareiss((ideal)v->Data(),0,0,m,&iv);
3454  lists l=(lists)omAllocBin(slists_bin);
3455  l->Init(2);
3456  l->m[0].rtyp=MODUL_CMD;
3457  l->m[1].rtyp=INTVEC_CMD;
3458  l->m[0].data=(void *)m;
3459  l->m[1].data=(void *)iv;
3460  res->data = (char *)l;
3461  return FALSE;
3462}
3463//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3464//{
3465//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3466//  ivTriangMat(m);
3467//  res->data = (char *)m;
3468//  return FALSE;
3469//}
3470static BOOLEAN jjBI2N(leftv res, leftv u)
3471{
3472  if (rField_is_Q())
3473  {
3474    res->data=u->CopyD();
3475    return FALSE;
3476  }
3477  else
3478  {
3479    BOOLEAN bo=FALSE;
3480    number n=(number)u->CopyD();
3481    if (rField_is_Zp())
3482    {
3483      res->data=(void *)npMap0(n);
3484    }
3485    else if (rField_is_Q_a())
3486    {
3487      res->data=(void *)naMap00(n);
3488    }
3489    else if (rField_is_Zp_a())
3490    {
3491      res->data=(void *)naMap0P(n);
3492    }
3493#ifdef HAVE_RINGS
3494    else if (rField_is_Ring_Z())
3495    {
3496      res->data=(void *)nrzMapQ(n);
3497    }
3498    else if (rField_is_Ring_ModN())
3499    {
3500      res->data=(void *)nrnMapQ(n);
3501    }
3502    else if (rField_is_Ring_PtoM())
3503    {
3504      res->data=(void *)nrnMapQ(n);
3505    }
3506    else if (rField_is_Ring_2toM())
3507    {
3508      res->data=(void *)nr2mMapQ(n);
3509    }
3510#endif
3511    else
3512    {
3513      WerrorS("cannot convert bigint to this field");
3514      bo=TRUE;
3515    }
3516    nlDelete(&n,NULL);
3517    return bo;
3518  }
3519}
3520static BOOLEAN jjBI2P(leftv res, leftv u)
3521{
3522  sleftv tmp;
3523  BOOLEAN bo=jjBI2N(&tmp,u);
3524  if (!bo)
3525  {
3526    number n=(number) tmp.data;
3527    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3528    else
3529    {
3530      res->data=(void *)pNSet(n);
3531    }
3532  }
3533  return bo;
3534}
3535static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3536{
3537  return iiExprArithM(res,u,iiOp);
3538}
3539static BOOLEAN jjCHAR(leftv res, leftv v)
3540{
3541  res->data = (char *)(long)rChar((ring)v->Data());
3542  return FALSE;
3543}
3544static BOOLEAN jjCOLS(leftv res, leftv v)
3545{
3546  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3547  return FALSE;
3548}
3549static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3550{
3551  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3552  return FALSE;
3553}
3554static BOOLEAN jjCONTENT(leftv res, leftv v)
3555{
3556  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3557  poly p=(poly)v->CopyD(POLY_CMD);
3558  if (p!=NULL) p_Cleardenom(p, currRing);
3559  res->data = (char *)p;
3560  return FALSE;
3561}
3562static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3563{
3564  res->data = (char *)(long)nlSize((number)v->Data());
3565  return FALSE;
3566}
3567static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3568{
3569  res->data = (char *)(long)nSize((number)v->Data());
3570  return FALSE;
3571}
3572static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3573{
3574  lists l=(lists)v->Data();
3575  res->data = (char *)(long)(l->nr+1);
3576  return FALSE;
3577}
3578static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3579{
3580  matrix m=(matrix)v->Data();
3581  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3582  return FALSE;
3583}
3584static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3585{
3586  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3587  return FALSE;
3588}
3589static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3590{
3591  ring r=(ring)v->Data();
3592  int elems=-1;
3593  if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
3594  else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
3595  {
3596#ifdef HAVE_FACTORY
3597    extern int ipower ( int b, int n ); /* factory/cf_util */
3598    elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
3599#else
3600    elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
3601#endif
3602  }
3603  res->data = (char *)(long)elems;
3604  return FALSE;
3605}
3606static BOOLEAN jjDEG(leftv res, leftv v)
3607{
3608  int dummy;
3609  poly p=(poly)v->Data();
3610  if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
3611  else res->data=(char *)-1;
3612  return FALSE;
3613}
3614static BOOLEAN jjDEG_M(leftv res, leftv u)
3615{
3616  ideal I=(ideal)u->Data();
3617  int d=-1;
3618  int dummy;
3619  int i;
3620  for(i=IDELEMS(I)-1;i>=0;i--)
3621    if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
3622  res->data = (char *)(long)d;
3623  return FALSE;
3624}
3625static BOOLEAN jjDEGREE(leftv res, leftv v)
3626{
3627  SPrintStart();
3628#ifdef HAVE_RINGS
3629  if (rField_is_Ring_Z(currRing))
3630  {
3631    ring origR = currRing;
3632    ring tempR = rCopy(origR);
3633    tempR->ringtype = 0; tempR->ch = 0;
3634    rComplete(tempR);
3635    ideal vid = (ideal)v->Data();
3636    rChangeCurrRing(tempR);
3637    ideal vv = idrCopyR(vid, origR, currRing);
3638    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3639    vvAsLeftv.rtyp = IDEAL_CMD;
3640    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3641    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3642    assumeStdFlag(&vvAsLeftv);
3643    Print("// NOTE: computation of degree is being performed for\n");
3644    Print("//       generic fibre, that is, over Q\n");
3645    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3646    scDegree(vv,module_w,currQuotient);
3647    idDelete(&vv);
3648    rChangeCurrRing(origR);
3649    rDelete(tempR);
3650  }
3651#endif
3652  assumeStdFlag(v);
3653  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3654  scDegree((ideal)v->Data(),module_w,currQuotient);
3655  char *s=SPrintEnd();
3656  int l=strlen(s)-1;
3657  s[l]='\0';
3658  res->data=(void*)s;
3659  return FALSE;
3660}
3661static BOOLEAN jjDEFINED(leftv res, leftv v)
3662{
3663  if ((v->rtyp==IDHDL)
3664  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3665  {
3666    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3667  }
3668  else if (v->rtyp!=0) res->data=(void *)(-1);
3669  return FALSE;
3670}
3671#ifdef HAVE_FACTORY
3672static BOOLEAN jjDET(leftv res, leftv v)
3673{
3674  matrix m=(matrix)v->Data();
3675  poly p;
3676  if (smCheckDet((ideal)m,m->cols(),TRUE))
3677  {
3678    ideal I=idMatrix2Module(mpCopy(m));
3679    p=smCallDet(I);
3680    idDelete(&I);
3681  }
3682  else
3683    p=singclap_det(m);
3684  res ->data = (char *)p;
3685  return FALSE;
3686}
3687static BOOLEAN jjDET_I(leftv res, leftv v)
3688{
3689  intvec * m=(intvec*)v->Data();
3690  int i,j;
3691  i=m->rows();j=m->cols();
3692  if(i==j)
3693    res->data = (char *)(long)singclap_det_i(m);
3694  else
3695  {
3696    Werror("det of %d x %d intmat",i,j);
3697    return TRUE;
3698  }
3699  return FALSE;
3700}
3701static BOOLEAN jjDET_S(leftv res, leftv v)
3702{
3703  ideal I=(ideal)v->Data();
3704  poly p;
3705  if (IDELEMS(I)<1) return TRUE;
3706  if (smCheckDet(I,IDELEMS(I),FALSE))
3707  {
3708    matrix m=idModule2Matrix(idCopy(I));
3709    p=singclap_det(m);
3710    idDelete((ideal *)&m);
3711  }
3712  else
3713    p=smCallDet(I);
3714  res->data = (char *)p;
3715  return FALSE;
3716}
3717#endif
3718static BOOLEAN jjDIM(leftv res, leftv v)
3719{
3720  assumeStdFlag(v);
3721#ifdef HAVE_RINGS
3722  if (rField_is_Ring(currRing))
3723  {
3724    ring origR = currRing;
3725    ring tempR = rCopy(origR);
3726    tempR->ringtype = 0; tempR->ch = 0;
3727    rComplete(tempR);
3728    ideal vid = (ideal)v->Data();
3729    int i = idPosConstant(vid);
3730    if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
3731    { /* ideal v contains unit; dim = -1 */
3732      res->data = (char *)-1;
3733      return FALSE;
3734    }
3735    rChangeCurrRing(tempR);
3736    ideal vv = idrCopyR(vid, origR, currRing);
3737    /* drop degree zero generator from vv (if any) */
3738    if (i != -1) pDelete(&vv->m[i]);
3739    long d = (long)scDimInt(vv, currQuotient);
3740    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
3741    res->data = (char *)d;
3742    idDelete(&vv);
3743    rChangeCurrRing(origR);
3744    rDelete(tempR);
3745    return FALSE;
3746  }
3747#endif
3748  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3749  return FALSE;
3750}
3751static BOOLEAN jjDUMP(leftv res, leftv v)
3752{
3753  si_link l = (si_link)v->Data();
3754  if (slDump(l))
3755  {
3756    const char *s;
3757    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3758    else                            s=sNoName;
3759    Werror("cannot dump to `%s`",s);
3760    return TRUE;
3761  }
3762  else
3763    return FALSE;
3764}
3765static BOOLEAN jjE(leftv res, leftv v)
3766{
3767  res->data = (char *)pOne();
3768  int co=(int)(long)v->Data();
3769  if (co>0)
3770  {
3771    pSetComp((poly)res->data,co);
3772    pSetm((poly)res->data);
3773  }
3774  else WerrorS("argument of gen must be positive");
3775  return (co<=0);
3776}
3777static BOOLEAN jjEXECUTE(leftv res, leftv v)
3778{
3779  char * d = (char *)v->Data();
3780  char * s = (char *)omAlloc(strlen(d) + 13);
3781  strcpy( s, (char *)d);
3782  strcat( s, "\n;RETURN();\n");
3783  newBuffer(s,BT_execute);
3784  return yyparse();
3785}
3786#ifdef HAVE_FACTORY
3787static BOOLEAN jjFACSTD(leftv res, leftv v)
3788{
3789  lists L=(lists)omAllocBin(slists_bin);
3790  if (rField_is_Zp()
3791  || rField_is_Q()
3792  || rField_is_Zp_a()
3793  || rField_is_Q_a())
3794  {
3795    ideal_list p,h;
3796    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3797    if (h==NULL)
3798    {
3799      L->Init(1);
3800      L->m[0].data=(char *)idInit(0,1);
3801      L->m[0].rtyp=IDEAL_CMD;
3802    }
3803    else
3804    {
3805      p=h;
3806      int l=0;
3807      while (p!=NULL) { p=p->next;l++; }
3808      L->Init(l);
3809      l=0;
3810      while(h!=NULL)
3811      {
3812        L->m[l].data=(char *)h->d;
3813        L->m[l].rtyp=IDEAL_CMD;
3814        p=h->next;
3815        omFreeSize(h,sizeof(*h));
3816        h=p;
3817        l++;
3818      }
3819    }
3820  }
3821  else
3822  {
3823    WarnS("no factorization implemented");
3824    L->Init(1);
3825    iiExprArith1(&(L->m[0]),v,STD_CMD);
3826  }
3827  res->data=(void *)L;
3828  return FALSE;
3829}
3830static BOOLEAN jjFAC_P(leftv res, leftv u)
3831{
3832  intvec *v=NULL;
3833  singclap_factorize_retry=0;
3834  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
3835  if (f==NULL) return TRUE;
3836  ivTest(v);
3837  lists l=(lists)omAllocBin(slists_bin);
3838  l->Init(2);
3839  l->m[0].rtyp=IDEAL_CMD;
3840  l->m[0].data=(void *)f;
3841  l->m[1].rtyp=INTVEC_CMD;
3842  l->m[1].data=(void *)v;
3843  res->data=(void *)l;
3844  return FALSE;
3845}
3846#endif
3847static BOOLEAN jjGETDUMP(leftv res, leftv v)
3848{
3849  si_link l = (si_link)v->Data();
3850  if (slGetDump(l))
3851  {
3852    const char *s;
3853    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3854    else                            s=sNoName;
3855    Werror("cannot get dump from `%s`",s);
3856    return TRUE;
3857  }
3858  else
3859    return FALSE;
3860}
3861static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
3862{
3863  assumeStdFlag(v);
3864  ideal I=(ideal)v->Data();
3865  res->data=(void *)iiHighCorner(I,0);
3866  return FALSE;
3867}
3868static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
3869{
3870  assumeStdFlag(v);
3871  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3872  BOOLEAN delete_w=FALSE;
3873  ideal I=(ideal)v->Data();
3874  int i;
3875  poly p=NULL,po=NULL;
3876  int rk=idRankFreeModule(I);
3877  if (w==NULL)
3878  {
3879    w = new intvec(rk);
3880    delete_w=TRUE;
3881  }
3882  for(i=rk;i>0;i--)
3883  {
3884    p=iiHighCorner(I,i);
3885    if (p==NULL)
3886    {
3887      WerrorS("module must be zero-dimensional");
3888      if (delete_w) delete w;
3889      return TRUE;
3890    }
3891    if (po==NULL)
3892    {
3893      po=p;
3894    }
3895    else
3896    {
3897      // now po!=NULL, p!=NULL
3898      int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
3899      if (d==0)
3900        d=pLmCmp(po,p);
3901      if (d > 0)
3902      {
3903        pDelete(&p);
3904      }
3905      else // (d < 0)
3906      {
3907        pDelete(&po); po=p;
3908      }
3909    }
3910  }
3911  if (delete_w) delete w;
3912  res->data=(void *)po;
3913  return FALSE;
3914}
3915static BOOLEAN jjHILBERT(leftv res, leftv v)
3916{
3917#ifdef HAVE_RINGS
3918  if (rField_is_Ring_Z(currRing))
3919  {
3920    ring origR = currRing;
3921    ring tempR = rCopy(origR);
3922    tempR->ringtype = 0; tempR->ch = 0;
3923    rComplete(tempR);
3924    ideal vid = (ideal)v->Data();
3925    rChangeCurrRing(tempR);
3926    ideal vv = idrCopyR(vid, origR, currRing);
3927    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3928    vvAsLeftv.rtyp = IDEAL_CMD;
3929    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3930    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3931    assumeStdFlag(&vvAsLeftv);
3932    Print("// NOTE: computation of Hilbert series etc. is being\n");
3933    Print("//       performed for generic fibre, that is, over Q\n");
3934    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3935    //scHilbertPoly(vv,currQuotient);
3936    hLookSeries(vv,module_w,currQuotient);
3937    idDelete(&vv);
3938    rChangeCurrRing(origR);
3939    rDelete(tempR);
3940    return FALSE;
3941  }
3942#endif
3943  assumeStdFlag(v);
3944  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3945  //scHilbertPoly((ideal)v->Data(),currQuotient);
3946  hLookSeries((ideal)v->Data(),module_w,currQuotient);
3947  return FALSE;
3948}
3949static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
3950{
3951#ifdef HAVE_RINGS
3952  if (rField_is_Ring_Z(currRing))
3953  {
3954    Print("// NOTE: computation of Hilbert series etc. is being\n");
3955    Print("//       performed for generic fibre, that is, over Q\n");
3956  }
3957#endif
3958  res->data=(void *)hSecondSeries((intvec *)v->Data());
3959  return FALSE;
3960}
3961static BOOLEAN jjHOMOG1(leftv res, leftv v)
3962{
3963  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3964  ideal v_id=(ideal)v->Data();
3965  if (w==NULL)
3966  {
3967    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
3968    if (res->data!=NULL)
3969    {
3970      if (v->rtyp==IDHDL)
3971      {
3972        char *s_isHomog=omStrDup("isHomog");
3973        if (v->e==NULL)
3974          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
3975        else
3976          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
3977      }
3978      else if (w!=NULL) delete w;
3979    } // if res->data==NULL then w==NULL
3980  }
3981  else
3982  {
3983    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
3984    if((res->data==NULL) && (v->rtyp==IDHDL))
3985    {
3986      if (v->e==NULL)
3987        atKill((idhdl)(v->data),"isHomog");
3988      else
3989        atKill((idhdl)(v->LData()),"isHomog");
3990    }
3991  }
3992  return FALSE;
3993}
3994static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
3995{
3996  res->data = (char *)idMaxIdeal((int)(long)v->Data());
3997  setFlag(res,FLAG_STD);
3998  return FALSE;
3999}
4000static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4001{
4002  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4003  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4004  if (IDELEMS((ideal)mat)==0)
4005  {
4006    idDelete((ideal *)&mat);
4007    mat=(matrix)idInit(1,1);
4008  }
4009  else
4010  {
4011    MATROWS(mat)=1;
4012    mat->rank=1;
4013    idTest((ideal)mat);
4014  }
4015  res->data=(char *)mat;
4016  return FALSE;
4017}
4018static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4019{
4020  map m=(map)v->CopyD(MAP_CMD);
4021  omFree((ADDRESS)m->preimage);
4022  m->preimage=NULL;
4023  ideal I=(ideal)m;
4024  I->rank=1;
4025  res->data=(char *)I;
4026  return FALSE;
4027}
4028static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4029{
4030  if (currRing!=NULL)
4031  {
4032    ring q=(ring)v->Data();
4033    if (rSamePolyRep(currRing, q))
4034    {
4035      if (q->qideal==NULL)
4036        res->data=(char *)idInit(1,1);
4037      else
4038        res->data=(char *)idCopy(q->qideal);
4039      return FALSE;
4040    }
4041  }
4042  WerrorS("can only get ideal from identical qring");
4043  return TRUE;
4044}
4045static BOOLEAN jjIm2Iv(leftv res, leftv v)
4046{
4047  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4048  iv->makeVector();
4049  res->data = iv;
4050  return FALSE;
4051}
4052static BOOLEAN jjIMPART(leftv res, leftv v)
4053{
4054  res->data = (char *)nImPart((number)v->Data());
4055  return FALSE;
4056}
4057static BOOLEAN jjINDEPSET(leftv res, leftv v)
4058{
4059  assumeStdFlag(v);
4060  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4061  return FALSE;
4062}
4063static BOOLEAN jjINTERRED(leftv res, leftv v)
4064{
4065  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4066  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4067  res->data = result;
4068  return FALSE;
4069}
4070static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4071{
4072  res->data = (char *)(long)pVar((poly)v->Data());
4073  return FALSE;
4074}
4075static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4076{
4077  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4078  return FALSE;
4079}
4080static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
4081{
4082  res->data = (char *)0;
4083  return FALSE;
4084}
4085static BOOLEAN jjJACOB_P(leftv res, leftv v)
4086{
4087  ideal i=idInit(pVariables,1);
4088  int k;
4089  poly p=(poly)(v->Data());
4090  for (k=pVariables;k>0;k--)
4091  {
4092    i->m[k-1]=pDiff(p,k);
4093  }
4094  res->data = (char *)i;
4095  return FALSE;
4096}
4097/*2
4098 * compute Jacobi matrix of a module/matrix
4099 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables))  ),
4100 * where Mt := transpose(M)
4101 * Note that this is consistent with the current conventions for jacob in Singular,
4102 * whereas M2 computes its transposed.
4103 */
4104static BOOLEAN jjJACOB_M(leftv res, leftv a)
4105{
4106  ideal id = (ideal)a->Data();
4107  id = idTransp(id);
4108  int W = IDELEMS(id);
4109
4110  ideal result = idInit(W * pVariables, id->rank);
4111  poly *p = result->m;
4112
4113  for( int v = 1; v <= pVariables; v++ )
4114  {
4115    poly* q = id->m;
4116    for( int i = 0; i < W; i++, p++, q++ )
4117      *p = pDiff( *q, v );
4118  }
4119  idDelete(&id);
4120
4121  res->data = (char *)result;
4122  return FALSE;
4123}
4124
4125
4126static BOOLEAN jjKBASE(leftv res, leftv v)
4127{
4128  assumeStdFlag(v);
4129  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4130  return FALSE;
4131}
4132#ifdef MDEBUG
4133static BOOLEAN jjpHead(leftv res, leftv v)
4134{
4135  res->data=(char *)pHead((poly)v->Data());
4136  return FALSE;
4137}
4138#endif
4139static BOOLEAN jjL2R(leftv res, leftv v)
4140{
4141  res->data=(char *)syConvList((lists)v->Data());
4142  if (res->data != NULL)
4143    return FALSE;
4144  else
4145    return TRUE;
4146}
4147static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4148{
4149  poly p=(poly)v->Data();
4150  if (p==NULL)
4151  {
4152    res->data=(char *)nInit(0);
4153  }
4154  else
4155  {
4156    res->data=(char *)nCopy(pGetCoeff(p));
4157  }
4158  return FALSE;
4159}
4160static BOOLEAN jjLEADEXP(leftv res, leftv v)
4161{
4162  poly p=(poly)v->Data();
4163  int s=pVariables;
4164  if (v->Typ()==VECTOR_CMD) s++;
4165  intvec *iv=new intvec(s);
4166  if (p!=NULL)
4167  {
4168    for(int i = pVariables;i;i--)
4169    {
4170      (*iv)[i-1]=pGetExp(p,i);
4171    }
4172    if (s!=pVariables)
4173      (*iv)[pVariables]=pGetComp(p);
4174  }
4175  res->data=(char *)iv;
4176  return FALSE;
4177}
4178static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4179{
4180  poly p=(poly)v->Data();
4181  if (p == NULL)
4182  {
4183    res->data = (char*) NULL;
4184  }
4185  else
4186  {
4187    poly lm = pLmInit(p);
4188    pSetCoeff(lm, nInit(1));
4189    res->data = (char*) lm;
4190  }
4191  return FALSE;
4192}
4193static BOOLEAN jjLOAD1(leftv res, leftv v)
4194{
4195  return jjLOAD(res, v,FALSE);
4196}
4197static BOOLEAN jjLISTRING(leftv res, leftv v)
4198{
4199  ring r=rCompose((lists)v->Data());
4200  if (r==NULL) return TRUE;
4201  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4202  res->data=(char *)r;
4203  return FALSE;
4204}
4205#if SIZEOF_LONG == 8
4206static number jjLONG2N(long d)
4207{
4208  int i=(int)d;
4209  if ((long)i == d)
4210  {
4211    return nlInit(i, NULL);
4212  }
4213  else
4214  {
4215#if !defined(OM_NDEBUG) && !defined(NDEBUG)
4216    omCheckBin(rnumber_bin);
4217#endif
4218    number z=(number)omAllocBin(rnumber_bin);
4219    #if defined(LDEBUG)
4220    z->debug=123456;
4221    #endif
4222    z->s=3;
4223    mpz_init_set_si(z->z,d);
4224    return z;
4225  }
4226}
4227#else
4228#define jjLONG2N(D) nlInit((int)D, NULL)
4229#endif
4230static BOOLEAN jjPFAC1(leftv res, leftv v)
4231{
4232  /* call method jjPFAC2 with second argument = 0 (meaning that no
4233     valid bound for the prime factors has been given) */
4234  sleftv tmp;
4235  memset(&tmp, 0, sizeof(tmp));
4236  tmp.rtyp = INT_CMD;
4237  return jjPFAC2(res, v, &tmp);
4238}
4239static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4240{
4241  /* computes the LU-decomposition of a matrix M;
4242     i.e., M = P * L * U, where
4243        - P is a row permutation matrix,
4244        - L is in lower triangular form,
4245        - U is in upper row echelon form
4246     Then, we also have P * M = L * U.
4247     A list [P, L, U] is returned. */
4248  matrix mat = (const matrix)v->Data();
4249  int rr = mat->rows();
4250  int cc = mat->cols();
4251  matrix pMat;
4252  matrix lMat;
4253  matrix uMat;
4254
4255  luDecomp(mat, pMat, lMat, uMat);
4256
4257  lists ll = (lists)omAllocBin(slists_bin);
4258  ll->Init(3);
4259  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4260  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4261  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4262  res->data=(char*)ll;
4263
4264  return FALSE;
4265}
4266static BOOLEAN jjMEMORY(leftv res, leftv v)
4267{
4268  omUpdateInfo();
4269  long d;
4270  switch(((int)(long)v->Data()))
4271  {
4272  case 0:
4273    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4274    break;
4275  case 1:
4276    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4277    break;
4278  case 2:
4279    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4280    break;
4281  default:
4282    omPrintStats(stdout);
4283    omPrintInfo(stdout);
4284    omPrintBinStats(stdout);
4285    res->data = (char *)0;
4286    res->rtyp = NONE;
4287  }
4288  return FALSE;
4289  res->data = (char *)0;
4290  return FALSE;
4291}
4292//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4293//{
4294//  return jjMONITOR2(res,v,NULL);
4295//}
4296static BOOLEAN jjMSTD(leftv res, leftv v)
4297{
4298  int t=v->Typ();
4299  ideal r,m;
4300  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4301  lists l=(lists)omAllocBin(slists_bin);
4302  l->Init(2);
4303  l->m[0].rtyp=t;
4304  l->m[0].data=(char *)r;
4305  setFlag(&(l->m[0]),FLAG_STD);
4306  l->m[1].rtyp=t;
4307  l->m[1].data=(char *)m;
4308  res->data=(char *)l;
4309  return FALSE;
4310}
4311static BOOLEAN jjMULT(leftv res, leftv v)
4312{
4313  assumeStdFlag(v);
4314  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4315  return FALSE;
4316}
4317static BOOLEAN jjMINRES_R(leftv res, leftv v)
4318{
4319  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4320
4321  syStrategy tmp=(syStrategy)v->Data();
4322  tmp = syMinimize(tmp); // enrich itself!
4323
4324  res->data=(char *)tmp;
4325
4326  if (weights!=NULL)
4327    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4328
4329  return FALSE;
4330}
4331static BOOLEAN jjN2BI(leftv res, leftv v)
4332{
4333  number n,i; i=(number)v->Data();
4334  if (rField_is_Zp())
4335  {
4336    n=nlInit(npInt(i,currRing),NULL);
4337  }
4338  else if (rField_is_Q()) n=nlBigInt(i);
4339#ifdef HAVE_RINGS
4340  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
4341  else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
4342#endif
4343  else goto err;
4344  res->data=(void *)n;
4345  return FALSE;
4346err:
4347  WerrorS("cannot convert to bigint"); return TRUE;
4348}
4349static BOOLEAN jjNAMEOF(leftv res, leftv v)
4350{
4351  res->data = (char *)v->name;
4352  if (res->data==NULL) res->data=omStrDup("");
4353  v->name=NULL;
4354  return FALSE;
4355}
4356static BOOLEAN jjNAMES(leftv res, leftv v)
4357{
4358  res->data=ipNameList(((ring)v->Data())->idroot);
4359  return FALSE;
4360}
4361static BOOLEAN jjNVARS(leftv res, leftv v)
4362{
4363  res->data = (char *)(long)(((ring)(v->Data()))->N);
4364  return FALSE;
4365}
4366static BOOLEAN jjOpenClose(leftv res, leftv v)
4367{
4368  si_link l=(si_link)v->Data();
4369  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4370  else                return slClose(l);
4371}
4372static BOOLEAN jjORD(leftv res, leftv v)
4373{
4374  poly p=(poly)v->Data();
4375  res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
4376  return FALSE;
4377}
4378static BOOLEAN jjPAR1(leftv res, leftv v)
4379{
4380  int i=(int)(long)v->Data();
4381  int p=0;
4382  p=rPar(currRing);
4383  if ((0<i) && (i<=p))
4384  {
4385    res->data=(char *)nPar(i);
4386  }
4387  else
4388  {
4389    Werror("par number %d out of range 1..%d",i,p);
4390    return TRUE;
4391  }
4392  return FALSE;
4393}
4394static BOOLEAN jjPARDEG(leftv res, leftv v)
4395{
4396  res->data = (char *)(long)nParDeg((number)v->Data());
4397  return FALSE;
4398}
4399static BOOLEAN jjPARSTR1(leftv res, leftv v)
4400{
4401  if (currRing==NULL)
4402  {
4403    WerrorS("no ring active");
4404    return TRUE;
4405  }
4406  int i=(int)(long)v->Data();
4407  int p=0;
4408  if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
4409    res->data=omStrDup(currRing->parameter[i-1]);
4410  else
4411  {
4412    Werror("par number %d out of range 1..%d",i,p);
4413    return TRUE;
4414  }
4415  return FALSE;
4416}
4417static BOOLEAN jjP2BI(leftv res, leftv v)
4418{
4419  poly p=(poly)v->Data();
4420  if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
4421  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4422  {
4423    WerrorS("poly must be constant");
4424    return TRUE;
4425  }
4426  number i=pGetCoeff(p);
4427  number n;
4428  if (rField_is_Zp())
4429  {
4430    n=nlInit(npInt(i,currRing), NULL);
4431  }
4432  else if (rField_is_Q()) n=nlBigInt(i);
4433#ifdef HAVE_RINGS
4434  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
4435    n=nlMapGMP(i);
4436  else if (rField_is_Ring_2toM())
4437    n=nlInit((unsigned long) i, NULL);
4438#endif
4439  else goto err;
4440  res->data=(void *)n;
4441  return FALSE;
4442err:
4443  WerrorS("cannot convert to bigint"); return TRUE;
4444}
4445static BOOLEAN jjP2I(leftv res, leftv v)
4446{
4447  poly p=(poly)v->Data();
4448  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4449  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4450  {
4451    WerrorS("poly must be constant");
4452    return TRUE;
4453  }
4454  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
4455  return FALSE;
4456}
4457static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4458{
4459  map mapping=(map)v->Data();
4460  syMake(res,omStrDup(mapping->preimage));
4461  return FALSE;
4462}
4463static BOOLEAN jjPRIME(leftv res, leftv v)
4464{
4465  int i = IsPrime((int)(long)(v->Data()));
4466  res->data = (char *)(long)(i > 1 ? i : 2);
4467  return FALSE;
4468}
4469static BOOLEAN jjPRUNE(leftv res, leftv v)
4470{
4471  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4472  ideal v_id=(ideal)v->Data();
4473  if (w!=NULL)
4474  {
4475    if (!idTestHomModule(v_id,currQuotient,w))
4476    {
4477      WarnS("wrong weights");
4478      w=NULL;
4479      // and continue at the non-homog case below
4480    }
4481    else
4482    {
4483      w=ivCopy(w);
4484      intvec **ww=&w;
4485      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4486      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4487      return FALSE;
4488    }
4489  }
4490  res->data = (char *)idMinEmbedding(v_id);
4491  return FALSE;
4492}
4493static BOOLEAN jjP2N(leftv res, leftv v)
4494{
4495  number n;
4496  poly p;
4497  if (((p=(poly)v->Data())!=NULL)
4498  && (pIsConstant(p)))
4499  {
4500    n=nCopy(pGetCoeff(p));
4501  }
4502  else
4503  {
4504    n=nInit(0);
4505  }
4506  res->data = (char *)n;
4507  return FALSE;
4508}
4509static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4510{
4511  char *s= (char *)v->Data();
4512  int i = 1;
4513  int l = strlen(s);
4514  for(i=0; i<sArithBase.nCmdUsed; i++)
4515  {
4516    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4517    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4518    {
4519      res->data = (char *)1;
4520      return FALSE;
4521    }
4522  }
4523  //res->data = (char *)0;
4524  return FALSE;
4525}
4526static BOOLEAN jjRANK1(leftv res, leftv v)
4527{
4528  matrix m =(matrix)v->Data();
4529  int rank = luRank(m, 0);
4530  res->data =(char *)(long)rank;
4531  return FALSE;
4532}
4533static BOOLEAN jjREAD(leftv res, leftv v)
4534{
4535  return jjREAD2(res,v,NULL);
4536}
4537static BOOLEAN jjREGULARITY(leftv res, leftv v)
4538{
4539  res->data = (char *)(long)iiRegularity((lists)v->Data());
4540  return FALSE;
4541}
4542static BOOLEAN jjREPART(leftv res, leftv v)
4543{
4544  res->data = (char *)nRePart((number)v->Data());
4545  return FALSE;
4546}
4547static BOOLEAN jjRINGLIST(leftv res, leftv v)
4548{
4549  ring r=(ring)v->Data();
4550  if (r!=NULL)
4551    res->data = (char *)rDecompose((ring)v->Data());
4552  return (r==NULL)||(res->data==NULL);
4553}
4554static BOOLEAN jjROWS(leftv res, leftv v)
4555{
4556  ideal i = (ideal)v->Data();
4557  res->data = (char *)i->rank;
4558  return FALSE;
4559}
4560static BOOLEAN jjROWS_IV(leftv res, leftv v)
4561{
4562  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4563  return FALSE;
4564}
4565static BOOLEAN jjRPAR(leftv res, leftv v)
4566{
4567  res->data = (char *)(long)rPar(((ring)v->Data()));
4568  return FALSE;
4569}
4570static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4571{
4572#ifdef HAVE_PLURAL
4573  const bool bIsSCA = rIsSCA(currRing);
4574#else
4575  const bool bIsSCA = false;
4576#endif
4577
4578  if ((currQuotient!=NULL) && !bIsSCA)
4579  {
4580    WerrorS("qring not supported by slimgb at the moment");
4581    return TRUE;
4582  }
4583  if (rHasLocalOrMixedOrdering_currRing())
4584  {
4585    WerrorS("ordering must be global for slimgb");
4586    return TRUE;
4587  }
4588  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4589  tHomog hom=testHomog;
4590  ideal u_id=(ideal)u->Data();
4591  if (w!=NULL)
4592  {
4593    if (!idTestHomModule(u_id,currQuotient,w))
4594    {
4595      WarnS("wrong weights");
4596      w=NULL;
4597    }
4598    else
4599    {
4600      w=ivCopy(w);
4601      hom=isHomog;
4602    }
4603  }
4604
4605  assume(u_id->rank>=idRankFreeModule(u_id));
4606  res->data=(char *)t_rep_gb(currRing,
4607    u_id,u_id->rank);
4608  //res->data=(char *)t_rep_gb(currRing, u_id);
4609
4610  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4611  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4612  return FALSE;
4613}
4614static BOOLEAN jjSTD(leftv res, leftv v)
4615{
4616  ideal result;
4617  ideal v_id=(ideal)v->Data();
4618  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4619  tHomog hom=testHomog;
4620  if (w!=NULL)
4621  {
4622    if (!idTestHomModule(v_id,currQuotient,w))
4623    {
4624      WarnS("wrong weights");
4625      w=NULL;
4626    }
4627    else
4628    {
4629      hom=isHomog;
4630      w=ivCopy(w);
4631    }
4632  }
4633  result=kStd(v_id,currQuotient,hom,&w);
4634  idSkipZeroes(result);
4635  res->data = (char *)result;
4636  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4637  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4638  return FALSE;
4639}
4640static BOOLEAN jjSort_Id(leftv res, leftv v)
4641{
4642  res->data = (char *)idSort((ideal)v->Data());
4643  return FALSE;
4644}
4645#ifdef HAVE_FACTORY
4646extern int singclap_factorize_retry;
4647static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4648{
4649  intvec *v=NULL;
4650  singclap_factorize_retry=0;
4651  ideal f=singclap_sqrfree((poly)(u->CopyD()));
4652  if (f==NULL)
4653    return TRUE;
4654  res->data=(void *)f;
4655  return FALSE;
4656}
4657#endif
4658#if 1
4659static BOOLEAN jjSYZYGY(leftv res, leftv v)
4660{
4661  intvec *w=NULL;
4662  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4663  if (w!=NULL) delete w;
4664  return FALSE;
4665}
4666#else
4667// activate, if idSyz handle module weights correctly !
4668static BOOLEAN jjSYZYGY(leftv res, leftv v)
4669{
4670  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4671  ideal v_id=(ideal)v->Data();
4672  tHomog hom=testHomog;
4673  int add_row_shift=0;
4674  if (w!=NULL)
4675  {
4676    w=ivCopy(w);
4677    add_row_shift=w->min_in();
4678    (*w)-=add_row_shift;
4679    if (idTestHomModule(v_id,currQuotient,w))
4680      hom=isHomog;
4681    else
4682    {
4683      //WarnS("wrong weights");
4684      delete w; w=NULL;
4685      hom=testHomog;
4686    }
4687  }
4688  res->data = (char *)idSyzygies(v_id,hom,&w);
4689  if (w!=NULL)
4690  {
4691    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4692  }
4693  return FALSE;
4694}
4695#endif
4696static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4697{
4698  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4699  return FALSE;
4700}
4701static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4702{
4703  res->data = (char *)ivTranp((intvec*)(v->Data()));
4704  return FALSE;
4705}
4706#ifdef HAVE_PLURAL
4707static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4708{
4709  ring    r = (ring)a->Data();
4710  //if (rIsPluralRing(r))
4711  if (r->OrdSgn==1)
4712  {
4713    res->data = rOpposite(r);
4714  }
4715  else
4716  {
4717    WarnS("opposite only for global orderings");
4718    res->data = rCopy(r);
4719  }
4720  return FALSE;
4721}
4722static BOOLEAN jjENVELOPE(leftv res, leftv a)
4723{
4724  ring    r = (ring)a->Data();
4725  if (rIsPluralRing(r))
4726  {
4727    //    ideal   i;
4728//     if (a->rtyp == QRING_CMD)
4729//     {
4730//       i = r->qideal;
4731//       r->qideal = NULL;
4732//     }
4733    ring s = rEnvelope(r);
4734//     if (a->rtyp == QRING_CMD)
4735//     {
4736//       ideal is  = idOppose(r,i); /* twostd? */
4737//       is        = idAdd(is,i);
4738//       s->qideal = i;
4739//     }
4740    res->data = s;
4741  }
4742  else  res->data = rCopy(r);
4743  return FALSE;
4744}
4745static BOOLEAN jjTWOSTD(leftv res, leftv a)
4746{
4747  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4748  else  res->data=(ideal)a->CopyD();
4749  setFlag(res,FLAG_STD);
4750  setFlag(res,FLAG_TWOSTD);
4751  return FALSE;
4752}
4753#endif
4754
4755static BOOLEAN jjTYPEOF(leftv res, leftv v)
4756{
4757  int t=(int)(long)v->data;
4758  switch (t)
4759  {
4760    case INT_CMD:        res->data=omStrDup("int"); break;
4761    case POLY_CMD:       res->data=omStrDup("poly"); break;
4762    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
4763    case STRING_CMD:     res->data=omStrDup("string"); break;
4764    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
4765    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
4766    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
4767    case MODUL_CMD:      res->data=omStrDup("module"); break;
4768    case MAP_CMD:        res->data=omStrDup("map"); break;
4769    case PROC_CMD:       res->data=omStrDup("proc"); break;
4770    case RING_CMD:       res->data=omStrDup("ring"); break;
4771    case QRING_CMD:      res->data=omStrDup("qring"); break;
4772    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
4773    case NUMBER_CMD:     res->data=omStrDup("number"); break;
4774    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
4775    case LIST_CMD:       res->data=omStrDup("list"); break;
4776    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
4777    case LINK_CMD:       res->data=omStrDup("link"); break;
4778    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
4779    case DEF_CMD:
4780    case NONE:           res->data=omStrDup("none"); break;
4781    default:
4782    {
4783      if (t>MAX_TOK)
4784        res->data=omStrDup(getBlackboxName(t));
4785      else
4786        res->data=omStrDup("?unknown type?");
4787      break;
4788    }
4789  }
4790  return FALSE;
4791}
4792static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
4793{
4794  res->data=(char *)pIsUnivariate((poly)v->Data());
4795  return FALSE;
4796}
4797static BOOLEAN jjVAR1(leftv res, leftv v)
4798{
4799  int i=(int)(long)v->Data();
4800  if ((0<i) && (i<=currRing->N))
4801  {
4802    poly p=pOne();
4803    pSetExp(p,i,1);
4804    pSetm(p);
4805    res->data=(char *)p;
4806  }
4807  else
4808  {
4809    Werror("var number %d out of range 1..%d",i,currRing->N);
4810    return TRUE;
4811  }
4812  return FALSE;
4813}
4814static BOOLEAN jjVARSTR1(leftv res, leftv v)
4815{
4816  if (currRing==NULL)
4817  {
4818    WerrorS("no ring active");
4819    return TRUE;
4820  }
4821  int i=(int)(long)v->Data();
4822  if ((0<i) && (i<=currRing->N))
4823    res->data=omStrDup(currRing->names[i-1]);
4824  else
4825  {
4826    Werror("var number %d out of range 1..%d",i,currRing->N);
4827    return TRUE;
4828  }
4829  return FALSE;
4830}
4831static BOOLEAN jjVDIM(leftv res, leftv v)
4832{
4833  assumeStdFlag(v);
4834  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
4835  return FALSE;
4836}
4837BOOLEAN jjWAIT1ST1(leftv res, leftv u)
4838{
4839// input: u: a list with links of type
4840//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4841// returns: -1:  the read state of all links is eof
4842//          i>0: (at least) u[i] is ready
4843  lists Lforks = (lists)u->Data();
4844  int i = slStatusSsiL(Lforks, -1);
4845  if(i == -2) /* error */
4846  {
4847    return TRUE;
4848  }
4849  res->data = (void*)(long)i;
4850  return FALSE;
4851}
4852BOOLEAN jjWAITALL1(leftv res, leftv u)
4853{
4854// input: u: a list with links of type
4855//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4856// returns: -1: the read state of all links is eof
4857//           1: all links are ready
4858//              (caution: at least one is ready, but some maybe dead)
4859  lists Lforks = (lists)u->CopyD();
4860  int i;
4861  int j = -1;
4862  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
4863  {
4864    i = slStatusSsiL(Lforks, -1);
4865    if(i == -2) /* error */
4866    {
4867      return TRUE;
4868    }
4869    if(i == -1)
4870    {
4871      break;
4872    }
4873    j = 1;
4874    Lforks->m[i-1].CleanUp();
4875    Lforks->m[i-1].rtyp=DEF_CMD;
4876    Lforks->m[i-1].data=NULL;
4877  }
4878  res->data = (void*)(long)j;
4879  Lforks->Clean();
4880  return FALSE;
4881}
4882static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
4883{
4884  char * s=(char *)v->CopyD();
4885  char libnamebuf[256];
4886  lib_types LT = type_of_LIB(s, libnamebuf);
4887#ifdef HAVE_DYNAMIC_LOADING
4888  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
4889#endif /* HAVE_DYNAMIC_LOADING */
4890  switch(LT)
4891  {
4892      default:
4893      case LT_NONE:
4894        Werror("%s: unknown type", s);
4895        break;
4896      case LT_NOTFOUND:
4897        Werror("cannot open %s", s);
4898        break;
4899
4900      case LT_SINGULAR:
4901      {
4902        char *plib = iiConvName(s);
4903        idhdl pl = IDROOT->get(plib,0);
4904        if (pl==NULL)
4905        {
4906          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
4907          IDPACKAGE(pl)->language = LANG_SINGULAR;
4908          IDPACKAGE(pl)->libname=omStrDup(plib);
4909        }
4910        else if (IDTYP(pl)!=PACKAGE_CMD)
4911        {
4912          Werror("can not create package `%s`",plib);
4913          omFree(plib);
4914          return TRUE;
4915        }
4916        package savepack=currPack;
4917        currPack=IDPACKAGE(pl);
4918        IDPACKAGE(pl)->loaded=TRUE;
4919        char libnamebuf[256];
4920        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
4921        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
4922        currPack=savepack;
4923        IDPACKAGE(pl)->loaded=(!bo);
4924        return bo;
4925      }
4926      case LT_MACH_O:
4927      case LT_ELF:
4928      case LT_HPUX:
4929#ifdef HAVE_DYNAMIC_LOADING
4930        return load_modules(s, libnamebuf, autoexport);
4931#else /* HAVE_DYNAMIC_LOADING */
4932        WerrorS("Dynamic modules are not supported by this version of Singular");
4933        break;
4934#endif /* HAVE_DYNAMIC_LOADING */
4935  }
4936  return TRUE;
4937}
4938
4939#ifdef INIT_BUG
4940#define XS(A) -((short)A)
4941#define jjstrlen       (proc1)1
4942#define jjpLength      (proc1)2
4943#define jjidElem       (proc1)3
4944#define jjmpDetBareiss (proc1)4
4945#define jjidFreeModule (proc1)5
4946#define jjidVec2Ideal  (proc1)6
4947#define jjrCharStr     (proc1)7
4948#ifndef MDEBUG
4949#define jjpHead        (proc1)8
4950#endif
4951#define jjidHead       (proc1)9
4952#define jjidMinBase    (proc1)11
4953#define jjsyMinBase    (proc1)12
4954#define jjpMaxComp     (proc1)13
4955#define jjmpTrace      (proc1)14
4956#define jjmpTransp     (proc1)15
4957#define jjrOrdStr      (proc1)16
4958#define jjrVarStr      (proc1)18
4959#define jjrParStr      (proc1)19
4960#define jjCOUNT_RES    (proc1)22
4961#define jjDIM_R        (proc1)23
4962#define jjidTransp     (proc1)24
4963
4964extern struct sValCmd1 dArith1[];
4965void jjInitTab1()
4966{
4967  int i=0;
4968  for (;dArith1[i].cmd!=0;i++)
4969  {
4970    if (dArith1[i].res<0)
4971    {
4972      switch ((int)dArith1[i].p)
4973      {
4974        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
4975        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
4976        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
4977        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
4978#ifndef HAVE_FACTORY
4979        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
4980#endif
4981        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
4982        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
4983#ifndef MDEBUG
4984        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
4985#endif
4986        case (int)jjidHead:       dArith1[i].p=(proc1)idHead; break;
4987        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
4988        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
4989        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
4990        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
4991        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
4992        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
4993        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
4994        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
4995        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
4996        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
4997        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
4998        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
4999      }
5000    }
5001  }
5002}
5003#else
5004#if defined(PROC_BUG)
5005#define XS(A) A
5006static BOOLEAN jjstrlen(leftv res, leftv v)
5007{
5008  res->data = (char *)strlen((char *)v->Data());
5009  return FALSE;
5010}
5011static BOOLEAN jjpLength(leftv res, leftv v)
5012{
5013  res->data = (char *)pLength((poly)v->Data());
5014  return FALSE;
5015}
5016static BOOLEAN jjidElem(leftv res, leftv v)
5017{
5018  res->data = (char *)idElem((ideal)v->Data());
5019  return FALSE;
5020}
5021static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5022{
5023  res->data = (char *)mpDetBareiss((matrix)v->Data());
5024  return FALSE;
5025}
5026static BOOLEAN jjidFreeModule(leftv res, leftv v)
5027{
5028  res->data = (char *)idFreeModule((int)(long)v->Data());
5029  return FALSE;
5030}
5031static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5032{
5033  res->data = (char *)idVec2Ideal((poly)v->Data());
5034  return FALSE;
5035}
5036static BOOLEAN jjrCharStr(leftv res, leftv v)
5037{
5038  res->data = rCharStr((ring)v->Data());
5039  return FALSE;
5040}
5041#ifndef MDEBUG
5042static BOOLEAN jjpHead(leftv res, leftv v)
5043{
5044  res->data = (char *)pHead((poly)v->Data());
5045  return FALSE;
5046}
5047#endif
5048static BOOLEAN jjidHead(leftv res, leftv v)
5049{
5050  res->data = (char *)idHead((ideal)v->Data());
5051  return FALSE;
5052}
5053static BOOLEAN jjidMinBase(leftv res, leftv v)
5054{
5055  res->data = (char *)idMinBase((ideal)v->Data());
5056  return FALSE;
5057}
5058static BOOLEAN jjsyMinBase(leftv res, leftv v)
5059{
5060  res->data = (char *)syMinBase((ideal)v->Data());
5061  return FALSE;
5062}
5063static BOOLEAN jjpMaxComp(leftv res, leftv v)
5064{
5065  res->data = (char *)pMaxComp((poly)v->Data());
5066  return FALSE;
5067}
5068static BOOLEAN jjmpTrace(leftv res, leftv v)
5069{
5070  res->data = (char *)mpTrace((matrix)v->Data());
5071  return FALSE;
5072}
5073static BOOLEAN jjmpTransp(leftv res, leftv v)
5074{
5075  res->data = (char *)mpTransp((matrix)v->Data());
5076  return FALSE;
5077}
5078static BOOLEAN jjrOrdStr(leftv res, leftv v)
5079{
5080  res->data = rOrdStr((ring)v->Data());
5081  return FALSE;
5082}
5083static BOOLEAN jjrVarStr(leftv res, leftv v)
5084{
5085  res->data = rVarStr((ring)v->Data());
5086  return FALSE;
5087}
5088static BOOLEAN jjrParStr(leftv res, leftv v)
5089{
5090  res->data = rParStr((ring)v->Data());
5091  return FALSE;
5092}
5093static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5094{
5095  res->data=(char *)sySize((syStrategy)v->Data());
5096  return FALSE;
5097}
5098static BOOLEAN jjDIM_R(leftv res, leftv v)
5099{
5100  res->data = (char *)syDim((syStrategy)v->Data());
5101  return FALSE;
5102}
5103static BOOLEAN jjidTransp(leftv res, leftv v)
5104{
5105  res->data = (char *)idTransp((ideal)v->Data());
5106  return FALSE;
5107}
5108#else
5109#define XS(A)          -((short)A)
5110#define jjstrlen       (proc1)strlen
5111#define jjpLength      (proc1)pLength
5112#define jjidElem       (proc1)idElem
5113#define jjmpDetBareiss (proc1)mpDetBareiss
5114#define jjidFreeModule (proc1)idFreeModule
5115#define jjidVec2Ideal  (proc1)idVec2Ideal
5116#define jjrCharStr     (proc1)rCharStr
5117#ifndef MDEBUG
5118#define jjpHead        (proc1)pHeadProc
5119#endif
5120#define jjidHead       (proc1)idHead
5121#define jjidMaxIdeal   (proc1)idMaxIdeal
5122#define jjidMinBase    (proc1)idMinBase
5123#define jjsyMinBase    (proc1)syMinBase
5124#define jjpMaxComp     (proc1)pMaxCompProc
5125#define jjmpTrace      (proc1)mpTrace
5126#define jjmpTransp     (proc1)mpTransp
5127#define jjrOrdStr      (proc1)rOrdStr
5128#define jjrVarStr      (proc1)rVarStr
5129#define jjrParStr      (proc1)rParStr
5130#define jjCOUNT_RES    (proc1)sySize
5131#define jjDIM_R        (proc1)syDim
5132#define jjidTransp     (proc1)idTransp
5133#endif
5134#endif
5135static BOOLEAN jjnInt(leftv res, leftv u)
5136{
5137  number n=(number)u->Data();
5138  res->data=(char *)(long)n_Int(n,currRing);
5139  return FALSE;
5140}
5141static BOOLEAN jjnlInt(leftv res, leftv u)
5142{
5143  number n=(number)u->Data();
5144  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
5145  return FALSE;
5146}
5147/*=================== operations with 3 args.: static proc =================*/
5148/* must be ordered: first operations for chars (infix ops),
5149 * then alphabetically */
5150static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5151{
5152  char *s= (char *)u->Data();
5153  int   r = (int)(long)v->Data();
5154  int   c = (int)(long)w->Data();
5155  int l = strlen(s);
5156
5157  if ( (r<1) || (r>l) || (c<0) )
5158  {
5159    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5160    return TRUE;
5161  }
5162  res->data = (char *)omAlloc((long)(c+1));
5163  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5164  return FALSE;
5165}
5166static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5167{
5168  intvec *iv = (intvec *)u->Data();
5169  int   r = (int)(long)v->Data();
5170  int   c = (int)(long)w->Data();
5171  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5172  {
5173    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5174           r,c,u->Fullname(),iv->rows(),iv->cols());
5175    return TRUE;
5176  }
5177  res->data=u->data; u->data=NULL;
5178  res->rtyp=u->rtyp; u->rtyp=0;
5179  res->name=u->name; u->name=NULL;
5180  Subexpr e=jjMakeSub(v);
5181          e->next=jjMakeSub(w);
5182  if (u->e==NULL) res->e=e;
5183  else
5184  {
5185    Subexpr h=u->e;
5186    while (h->next!=NULL) h=h->next;
5187    h->next=e;
5188    res->e=u->e;
5189    u->e=NULL;
5190  }
5191  return FALSE;
5192}
5193static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5194{
5195  matrix m= (matrix)u->Data();
5196  int   r = (int)(long)v->Data();
5197  int   c = (int)(long)w->Data();
5198  //Print("gen. elem %d, %d\n",r,c);
5199  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5200  {
5201    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5202      MATROWS(m),MATCOLS(m));
5203    return TRUE;
5204  }
5205  res->data=u->data; u->data=NULL;
5206  res->rtyp=u->rtyp; u->rtyp=0;
5207  res->name=u->name; u->name=NULL;
5208  Subexpr e=jjMakeSub(v);
5209          e->next=jjMakeSub(w);
5210  if (u->e==NULL)
5211    res->e=e;
5212  else
5213  {
5214    Subexpr h=u->e;
5215    while (h->next!=NULL) h=h->next;
5216    h->next=e;
5217    res->e=u->e;
5218    u->e=NULL;
5219  }
5220  return FALSE;
5221}
5222static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5223{
5224  sleftv t;
5225  sleftv ut;
5226  leftv p=NULL;
5227  intvec *iv=(intvec *)w->Data();
5228  int l;
5229  BOOLEAN nok;
5230
5231  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5232  {
5233    WerrorS("cannot build expression lists from unnamed objects");
5234    return TRUE;
5235  }
5236  memcpy(&ut,u,sizeof(ut));
5237  memset(&t,0,sizeof(t));
5238  t.rtyp=INT_CMD;
5239  for (l=0;l< iv->length(); l++)
5240  {
5241    t.data=(char *)(long)((*iv)[l]);
5242    if (p==NULL)
5243    {
5244      p=res;
5245    }
5246    else
5247    {
5248      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5249      p=p->next;
5250    }
5251    memcpy(u,&ut,sizeof(ut));
5252    if (u->Typ() == MATRIX_CMD)
5253      nok=jjBRACK_Ma(p,u,v,&t);
5254    else /* INTMAT_CMD */
5255      nok=jjBRACK_Im(p,u,v,&t);
5256    if (nok)
5257    {
5258      while (res->next!=NULL)
5259      {
5260        p=res->next->next;
5261        omFreeBin((ADDRESS)res->next, sleftv_bin);
5262        // res->e aufraeumen !!!!
5263        res->next=p;
5264      }
5265      return TRUE;
5266    }
5267  }
5268  return FALSE;
5269}
5270static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5271{
5272  sleftv t;
5273  sleftv ut;
5274  leftv p=NULL;
5275  intvec *iv=(intvec *)v->Data();
5276  int l;
5277  BOOLEAN nok;
5278
5279  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5280  {
5281    WerrorS("cannot build expression lists from unnamed objects");
5282    return TRUE;
5283  }
5284  memcpy(&ut,u,sizeof(ut));
5285  memset(&t,0,sizeof(t));
5286  t.rtyp=INT_CMD;
5287  for (l=0;l< iv->length(); l++)
5288  {
5289    t.data=(char *)(long)((*iv)[l]);
5290    if (p==NULL)
5291    {
5292      p=res;
5293    }
5294    else
5295    {
5296      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5297      p=p->next;
5298    }
5299    memcpy(u,&ut,sizeof(ut));
5300    if (u->Typ() == MATRIX_CMD)
5301      nok=jjBRACK_Ma(p,u,&t,w);
5302    else /* INTMAT_CMD */
5303      nok=jjBRACK_Im(p,u,&t,w);
5304    if (nok)
5305    {
5306      while (res->next!=NULL)
5307      {
5308        p=res->next->next;
5309        omFreeBin((ADDRESS)res->next, sleftv_bin);
5310        // res->e aufraeumen !!
5311        res->next=p;
5312      }
5313      return TRUE;
5314    }
5315  }
5316  return FALSE;
5317}
5318static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5319{
5320  sleftv t1,t2,ut;
5321  leftv p=NULL;
5322  intvec *vv=(intvec *)v->Data();
5323  intvec *wv=(intvec *)w->Data();
5324  int vl;
5325  int wl;
5326  BOOLEAN nok;
5327
5328  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5329  {
5330    WerrorS("cannot build expression lists from unnamed objects");
5331    return TRUE;
5332  }
5333  memcpy(&ut,u,sizeof(ut));
5334  memset(&t1,0,sizeof(sleftv));
5335  memset(&t2,0,sizeof(sleftv));
5336  t1.rtyp=INT_CMD;
5337  t2.rtyp=INT_CMD;
5338  for (vl=0;vl< vv->length(); vl++)
5339  {
5340    t1.data=(char *)(long)((*vv)[vl]);
5341    for (wl=0;wl< wv->length(); wl++)
5342    {
5343      t2.data=(char *)(long)((*wv)[wl]);
5344      if (p==NULL)
5345      {
5346        p=res;
5347      }
5348      else
5349      {
5350        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5351        p=p->next;
5352      }
5353      memcpy(u,&ut,sizeof(ut));
5354      if (u->Typ() == MATRIX_CMD)
5355        nok=jjBRACK_Ma(p,u,&t1,&t2);
5356      else /* INTMAT_CMD */
5357        nok=jjBRACK_Im(p,u,&t1,&t2);
5358      if (nok)
5359      {
5360        res->CleanUp();
5361        return TRUE;
5362      }
5363    }
5364  }
5365  return FALSE;
5366}
5367static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5368{
5369  v->next=(leftv)omAllocBin(sleftv_bin);
5370  memcpy(v->next,w,sizeof(sleftv));
5371  memset(w,0,sizeof(sleftv));
5372  return jjPROC(res,u,v);
5373}
5374static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5375{
5376  u->next=(leftv)omAllocBin(sleftv_bin);
5377  memcpy(u->next,v,sizeof(sleftv));
5378  u->next->next=(leftv)omAllocBin(sleftv_bin);
5379  memcpy(u->next->next,w,sizeof(sleftv));
5380  BOOLEAN r=iiExprArithM(res,u,iiOp);
5381  v->Init();
5382  w->Init();
5383  //w->rtyp=0; w->data=NULL;
5384  // iiExprArithM did the CleanUp
5385  return r;
5386}
5387static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5388{
5389  intvec *iv;
5390  ideal m;
5391  lists l=(lists)omAllocBin(slists_bin);
5392  int k=(int)(long)w->Data();
5393  if (k>=0)
5394  {
5395    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5396    l->Init(2);
5397    l->m[0].rtyp=MODUL_CMD;
5398    l->m[1].rtyp=INTVEC_CMD;
5399    l->m[0].data=(void *)m;
5400    l->m[1].data=(void *)iv;
5401  }
5402  else
5403  {
5404    m=smCallSolv((ideal)u->Data());
5405    l->Init(1);
5406    l->m[0].rtyp=IDEAL_CMD;
5407    l->m[0].data=(void *)m;
5408  }
5409  res->data = (char *)l;
5410  return FALSE;
5411}
5412static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5413{
5414  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5415  {
5416    WerrorS("3rd argument must be a name of a matrix");
5417    return TRUE;
5418  }
5419  ideal i=(ideal)u->Data();
5420  int rank=(int)i->rank;
5421  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5422  if (r) return TRUE;
5423  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5424  return FALSE;
5425}
5426static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5427{
5428  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5429           (ideal)(v->Data()),(poly)(w->Data()));
5430  return FALSE;
5431}
5432static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5433{
5434  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5435  {
5436    WerrorS("3rd argument must be a name of a matrix");
5437    return TRUE;
5438  }
5439  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5440  poly p=(poly)u->CopyD(POLY_CMD);
5441  ideal i=idInit(1,1);
5442  i->m[0]=p;
5443  sleftv t;
5444  memset(&t,0,sizeof(t));
5445  t.data=(char *)i;
5446  t.rtyp=IDEAL_CMD;
5447  int rank=1;
5448  if (u->Typ()==VECTOR_CMD)
5449  {
5450    i->rank=rank=pMaxComp(p);
5451    t.rtyp=MODUL_CMD;
5452  }
5453  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5454  t.CleanUp();
5455  if (r) return TRUE;
5456  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5457  return FALSE;
5458}
5459static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5460{
5461  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5462    (intvec *)w->Data());
5463  //setFlag(res,FLAG_STD);
5464  return FALSE;
5465}
5466static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5467{
5468  /*4
5469  * look for the substring what in the string where
5470  * starting at position n
5471  * return the position of the first char of what in where
5472  * or 0
5473  */
5474  int n=(int)(long)w->Data();
5475  char *where=(char *)u->Data();
5476  char *what=(char *)v->Data();
5477  char *found;
5478  if ((1>n)||(n>(int)strlen(where)))
5479  {
5480    Werror("start position %d out of range",n);
5481    return TRUE;
5482  }
5483  found = strchr(where+n-1,*what);
5484  if (*(what+1)!='\0')
5485  {
5486    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5487    {
5488      found=strchr(found+1,*what);
5489    }
5490  }
5491  if (found != NULL)
5492  {
5493    res->data=(char *)((found-where)+1);
5494  }
5495  return FALSE;
5496}
5497static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5498{
5499  if ((int)(long)w->Data()==0)
5500    res->data=(char *)walkProc(u,v);
5501  else
5502    res->data=(char *)fractalWalkProc(u,v);
5503  setFlag( res, FLAG_STD );
5504  return FALSE;
5505}
5506static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5507{
5508  intvec *wdegree=(intvec*)w->Data();
5509  if (wdegree->length()!=pVariables)
5510  {
5511    Werror("weight vector must have size %d, not %d",
5512           pVariables,wdegree->length());
5513    return TRUE;
5514  }
5515#ifdef HAVE_RINGS
5516  if (rField_is_Ring_Z(currRing))
5517  {
5518    ring origR = currRing;
5519    ring tempR = rCopy(origR);
5520    tempR->ringtype = 0; tempR->ch = 0;
5521    rComplete(tempR);
5522    ideal uid = (ideal)u->Data();
5523    rChangeCurrRing(tempR);
5524    ideal uu = idrCopyR(uid, origR, currRing);
5525    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5526    uuAsLeftv.rtyp = IDEAL_CMD;
5527    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5528    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5529    assumeStdFlag(&uuAsLeftv);
5530    Print("// NOTE: computation of Hilbert series etc. is being\n");
5531    Print("//       performed for generic fibre, that is, over Q\n");
5532    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5533    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5534    int returnWithTrue = 1;
5535    switch((int)(long)v->Data())
5536    {
5537      case 1:
5538        res->data=(void *)iv;
5539        returnWithTrue = 0;
5540      case 2:
5541        res->data=(void *)hSecondSeries(iv);
5542        delete iv;
5543        returnWithTrue = 0;
5544    }
5545    if (returnWithTrue)
5546    {
5547      WerrorS(feNotImplemented);
5548      delete iv;
5549    }
5550    idDelete(&uu);
5551    rChangeCurrRing(origR);
5552    rDelete(tempR);
5553    if (returnWithTrue) return TRUE; else return FALSE;
5554  }
5555#endif
5556  assumeStdFlag(u);
5557  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5558  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5559  switch((int)(long)v->Data())
5560  {
5561    case 1:
5562      res->data=(void *)iv;
5563      return FALSE;
5564    case 2:
5565      res->data=(void *)hSecondSeries(iv);
5566      delete iv;
5567      return FALSE;
5568  }
5569  WerrorS(feNotImplemented);
5570  delete iv;
5571  return TRUE;
5572}
5573static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5574{
5575  PrintS("TODO\n");
5576  int i=pVar((poly)v->Data());
5577  if (i==0)
5578  {
5579    WerrorS("ringvar expected");
5580    return TRUE;
5581  }
5582  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5583  int d=pWTotaldegree(p);
5584  pLmDelete(p);
5585  if (d==1)
5586    res->data = (char *)idHomogen((ideal)u->Data(),i);
5587  else
5588    WerrorS("variable must have weight 1");
5589  return (d!=1);
5590}
5591static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5592{
5593  PrintS("TODO\n");
5594  int i=pVar((poly)v->Data());
5595  if (i==0)
5596  {
5597    WerrorS("ringvar expected");
5598    return TRUE;
5599  }
5600  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5601  int d=pWTotaldegree(p);
5602  pLmDelete(p);
5603  if (d==1)
5604    res->data = (char *)pHomogen((poly)u->Data(),i);
5605  else
5606    WerrorS("variable must have weight 1");
5607  return (d!=1);
5608}
5609static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5610{
5611  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5612  intvec* arg = (intvec*) u->Data();
5613  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5614
5615  for (i=0; i<n; i++)
5616  {
5617    (*im)[i] = (*arg)[i];
5618  }
5619
5620  res->data = (char *)im;
5621  return FALSE;
5622}
5623static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5624{
5625  short *iw=iv2array((intvec *)w->Data());
5626  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5627  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
5628  return FALSE;
5629}
5630static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5631{
5632  if (!pIsUnit((poly)v->Data()))
5633  {
5634    WerrorS("2nd argument must be a unit");
5635    return TRUE;
5636  }
5637  res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
5638  return FALSE;
5639}
5640static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5641{
5642  res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
5643                             (intvec *)w->Data());
5644  return FALSE;
5645}
5646static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5647{
5648  if (!mpIsDiagUnit((matrix)v->Data()))
5649  {
5650    WerrorS("2nd argument must be a diagonal matrix of units");
5651    return TRUE;
5652  }
5653  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5654                               (matrix)v->CopyD());
5655  return FALSE;
5656}
5657static BOOLEAN currRingIsOverIntegralDomain ()
5658{
5659  /* true for fields and Z, false otherwise */
5660  if (rField_is_Ring_PtoM()) return FALSE;
5661  if (rField_is_Ring_2toM()) return FALSE;
5662  if (rField_is_Ring_ModN()) return FALSE;
5663  return TRUE;
5664}
5665static BOOLEAN jjMINOR_M(leftv res, leftv v)
5666{
5667  /* Here's the use pattern for the minor command:
5668        minor ( matrix_expression m, int_expression minorSize,
5669                optional ideal_expression IasSB, optional int_expression k,
5670                optional string_expression algorithm,
5671                optional int_expression cachedMinors,
5672                optional int_expression cachedMonomials )
5673     This method here assumes that there are at least two arguments.
5674     - If IasSB is present, it must be a std basis. All minors will be
5675       reduced w.r.t. IasSB.
5676     - If k is absent, all non-zero minors will be computed.
5677       If k is present and k > 0, the first k non-zero minors will be
5678       computed.
5679       If k is present and k < 0, the first |k| minors (some of which
5680       may be zero) will be computed.
5681       If k is present and k = 0, an error is reported.
5682     - If algorithm is absent, all the following arguments must be absent too.
5683       In this case, a heuristic picks the best-suited algorithm (among
5684       Bareiss, Laplace, and Laplace with caching).
5685       If algorithm is present, it must be one of "Bareiss", "bareiss",
5686       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5687       "cache" two more arguments may be given, determining how many entries
5688       the cache may have at most, and how many cached monomials there are at
5689       most. (Cached monomials are counted over all cached polynomials.)
5690       If these two additional arguments are not provided, 200 and 100000
5691       will be used as defaults.
5692  */
5693  matrix m;
5694  leftv u=v->next;
5695  v->next=NULL;
5696  int v_typ=v->Typ();
5697  if (v_typ==MATRIX_CMD)
5698  {
5699     m = (const matrix)v->Data();
5700  }
5701  else
5702  {
5703    if (v_typ==0)
5704    {
5705      Werror("`%s` is undefined",v->Fullname());
5706      return TRUE;
5707    }
5708    // try to convert to MATRIX:
5709    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5710    BOOLEAN bo;
5711    sleftv tmp;
5712    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5713    else bo=TRUE;
5714    if (bo)
5715    {
5716      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5717      return TRUE;
5718    }
5719    m=(matrix)tmp.data;
5720  }
5721  const int mk = (const int)(long)u->Data();
5722  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5723  bool noCacheMinors = true; bool noCacheMonomials = true;
5724  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5725
5726  /* here come the different cases of correct argument sets */
5727  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5728  {
5729    IasSB = (ideal)u->next->Data();
5730    noIdeal = false;
5731    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5732    {
5733      k = (int)(long)u->next->next->Data();
5734      noK = false;
5735      assume(k != 0);
5736      if ((u->next->next->next != NULL) &&
5737          (u->next->next->next->Typ() == STRING_CMD))
5738      {
5739        algorithm = (char*)u->next->next->next->Data();
5740        noAlgorithm = false;
5741        if ((u->next->next->next->next != NULL) &&
5742            (u->next->next->next->next->Typ() == INT_CMD))
5743        {
5744          cacheMinors = (int)(long)u->next->next->next->next->Data();
5745          noCacheMinors = false;
5746          if ((u->next->next->next->next->next != NULL) &&
5747              (u->next->next->next->next->next->Typ() == INT_CMD))
5748          {
5749            cacheMonomials =
5750               (int)(long)u->next->next->next->next->next->Data();
5751            noCacheMonomials = false;
5752          }
5753        }
5754      }
5755    }
5756  }
5757  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5758  {
5759    k = (int)(long)u->next->Data();
5760    noK = false;
5761    assume(k != 0);
5762    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5763    {
5764      algorithm = (char*)u->next->next->Data();
5765      noAlgorithm = false;
5766      if ((u->next->next->next != NULL) &&
5767          (u->next->next->next->Typ() == INT_CMD))
5768      {
5769        cacheMinors = (int)(long)u->next->next->next->Data();
5770        noCacheMinors = false;
5771        if ((u->next->next->next->next != NULL) &&
5772            (u->next->next->next->next->Typ() == INT_CMD))
5773        {
5774          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5775          noCacheMonomials = false;
5776        }
5777      }
5778    }
5779  }
5780  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5781  {
5782    algorithm = (char*)u->next->Data();
5783    noAlgorithm = false;
5784    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5785    {
5786      cacheMinors = (int)(long)u->next->next->Data();
5787      noCacheMinors = false;
5788      if ((u->next->next->next != NULL) &&
5789          (u->next->next->next->Typ() == INT_CMD))
5790      {
5791        cacheMonomials = (int)(long)u->next->next->next->Data();
5792        noCacheMonomials = false;
5793      }
5794    }
5795  }
5796
5797  /* upper case conversion for the algorithm if present */
5798  if (!noAlgorithm)
5799  {
5800    if (strcmp(algorithm, "bareiss") == 0)
5801      algorithm = (char*)"Bareiss";
5802    if (strcmp(algorithm, "laplace") == 0)
5803      algorithm = (char*)"Laplace";
5804    if (strcmp(algorithm, "cache") == 0)
5805      algorithm = (char*)"Cache";
5806  }
5807
5808  v->next=u;
5809  /* here come some tests */
5810  if (!noIdeal)
5811  {
5812    assumeStdFlag(u->next);
5813  }