source: git/Singular/iparith.cc @ 3542f7

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