source: git/Singular/iparith.cc @ 3fa56b

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