source: git/Singular/iparith.cc @ 861529

spielwiese
Last change on this file since 861529 was 861529, checked in by Hans Schoenemann <hannes@…>, 13 years ago
fix pShift -> p_Shift
  • Property mode set to 100644
File size: 207.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: table driven kernel interface, used by interpreter
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <ctype.h>
13#include <stdio.h>
14#include <time.h>
15#include <unistd.h>
16
17#include <kernel/mod2.h>
18#include <Singular/tok.h>
19#include <kernel/options.h>
20#include <Singular/ipid.h>
21#include <kernel/intvec.h>
22#include <omalloc/omalloc.h>
23#include <kernel/polys.h>
24#include <kernel/febase.h>
25#include <Singular/sdb.h>
26#include <kernel/longalg.h>
27#include <kernel/longtrans.h>
28#include <kernel/ideals.h>
29#include <kernel/prCopy.h>
30#include <kernel/matpol.h>
31#include <kernel/kstd1.h>
32#include <kernel/timer.h>
33#include <kernel/ring.h>
34#include <Singular/subexpr.h>
35#include <Singular/lists.h>
36#include <kernel/modulop.h>
37#ifdef HAVE_RINGS
38#include <kernel/rmodulon.h>
39#include <kernel/rmodulo2m.h>
40#include <kernel/rintegers.h>
41#endif
42#include <kernel/numbers.h>
43#include <kernel/stairc.h>
44#include <kernel/maps.h>
45#include <Singular/maps_ip.h>
46#include <kernel/syz.h>
47#include <kernel/weight.h>
48#include <Singular/ipconv.h>
49#include <Singular/ipprint.h>
50#include <Singular/attrib.h>
51#include <Singular/silink.h>
52#include <kernel/sparsmat.h>
53#include <kernel/units.h>
54#include <Singular/janet.h>
55#include <kernel/GMPrat.h>
56#include <kernel/tgb.h>
57#include <kernel/walkProc.h>
58#include <kernel/mod_raw.h>
59#include <Singular/MinorInterface.h>
60#include <kernel/linearAlgebra.h>
61#include <Singular/misc_ip.h>
62#ifdef HAVE_FACTORY
63#  include <kernel/clapsing.h>
64#  include <kernel/kstdfac.h>
65#endif /* HAVE_FACTORY */
66#ifdef HAVE_FACTORY
67#  include <kernel/fglm.h>
68#endif /* HAVE_FACTORY */
69#include <Singular/interpolation.h>
70
71#include <Singular/blackbox.h>
72#include <Singular/newstruct.h>
73#include <Singular/ipshell.h>
74#include <kernel/mpr_inout.h>
75
76#include <kernel/timer.h>
77
78// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
79
80#ifdef HAVE_PLURAL
81  #include <kernel/gring.h>
82  #include <kernel/sca.h>
83  #define ALLOW_PLURAL     1
84  #define NO_PLURAL        0
85  #define COMM_PLURAL      2
86  #define  PLURAL_MASK 3
87#else /* HAVE_PLURAL */
88  #define ALLOW_PLURAL     0
89  #define NO_PLURAL        0
90  #define COMM_PLURAL      0
91  #define  PLURAL_MASK     0
92#endif /* HAVE_PLURAL */
93
94#ifdef HAVE_RINGS
95  #define RING_MASK        4
96  #define ZERODIVISOR_MASK 8
97#else
98  #define RING_MASK        0
99  #define ZERODIVISOR_MASK 0
100#endif
101#define ALLOW_RING       4
102#define NO_RING          0
103#define NO_ZERODIVISOR   8
104#define ALLOW_ZERODIVISOR  0
105
106static BOOLEAN check_valid(const int p, const int op);
107
108/*=============== types =====================*/
109struct sValCmdTab
110{
111  short cmd;
112  short start;
113};
114
115typedef sValCmdTab jjValCmdTab[];
116
117struct _scmdnames
118{
119  char *name;
120  short alias;
121  short tokval;
122  short toktype;
123};
124typedef struct _scmdnames cmdnames;
125
126
127typedef char * (*Proc1)(char *);
128struct sValCmd1
129{
130  proc1 p;
131  short cmd;
132  short res;
133  short arg;
134  short valid_for;
135};
136
137typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
138struct sValCmd2
139{
140  proc2 p;
141  short cmd;
142  short res;
143  short arg1;
144  short arg2;
145  short valid_for;
146};
147
148typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
149struct sValCmd3
150{
151  proc3 p;
152  short cmd;
153  short res;
154  short arg1;
155  short arg2;
156  short arg3;
157  short valid_for;
158};
159struct sValCmdM
160{
161  proc1 p;
162  short cmd;
163  short res;
164  short number_of_args; /* -1: any, -2: any >0, .. */
165  short valid_for;
166};
167
168typedef struct
169{
170  cmdnames *sCmds;             /**< array of existing commands */
171  struct sValCmd1 *psValCmd1;
172  struct sValCmd2 *psValCmd2;
173  struct sValCmd3 *psValCmd3;
174  struct sValCmdM *psValCmdM;
175  int nCmdUsed;      /**< number of commands used */
176  int nCmdAllocated; /**< number of commands-slots allocated */
177  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
178} SArithBase;
179
180/*---------------------------------------------------------------------*
181 * File scope Variables (Variables share by several functions in
182 *                       the same file )
183 *
184 *---------------------------------------------------------------------*/
185static SArithBase sArithBase;  /**< Base entry for arithmetic */
186
187/*---------------------------------------------------------------------*
188 * Extern Functions declarations
189 *
190 *---------------------------------------------------------------------*/
191static int _gentable_sort_cmds(const void *a, const void *b);
192extern int iiArithRemoveCmd(char *szName);
193extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
194                         short nToktype, short nPos=-1);
195
196/*============= proc =======================*/
197static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
198static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
199#ifdef MDEBUG
200#define jjMakeSub(A) jjDBMakeSub(A,__FILE__,__LINE__)
201static Subexpr jjDBMakeSub(leftv e,const char *f,const  int l);
202#else
203static Subexpr jjMakeSub(leftv e);
204#endif
205
206/*============= vars ======================*/
207extern int cmdtok;
208extern BOOLEAN expected_parms;
209
210#define ii_div_by_0 "div. by 0"
211
212int iiOp; /* the current operation*/
213
214/*=================== operations with 2 args.: static proc =================*/
215/* must be ordered: first operations for chars (infix ops),
216 * then alphabetically */
217
218static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
219{
220  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
221  int bb = (int)(long)(v->Data());
222  if (errorreported) return TRUE;
223  switch (iiOp)
224  {
225    case '+': (*aa) += bb; break;
226    case '-': (*aa) -= bb; break;
227    case '*': (*aa) *= bb; break;
228    case '/':
229    case INTDIV_CMD: (*aa) /= bb; break;
230    case '%':
231    case INTMOD_CMD: (*aa) %= bb; break;
232  }
233  res->data=(char *)aa;
234  return FALSE;
235}
236static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
237{
238  return jjOP_IV_I(res,v,u);
239}
240static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
241{
242  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
243  int bb = (int)(long)(v->Data());
244  int i=si_min(aa->rows(),aa->cols());
245  switch (iiOp)
246  {
247    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
248              break;
249    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
250              break;
251  }
252  res->data=(char *)aa;
253  return FALSE;
254}
255static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
256{
257  return jjOP_IM_I(res,v,u);
258}
259static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
260{
261  int l=(int)(long)v->Data();
262  if (l>0)
263  {
264    int d=(int)(long)u->Data();
265    intvec *vv=new intvec(l);
266    int i;
267    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
268    res->data=(char *)vv;
269  }
270  return (l<=0);
271}
272static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
273{
274  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
275  return FALSE;
276}
277static void jjEQUAL_REST(leftv res,leftv u,leftv v);
278static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
279{
280  intvec*    a = (intvec * )(u->Data());
281  intvec*    b = (intvec * )(v->Data());
282  int r=a->compare(b);
283  switch  (iiOp)
284  {
285    case '<':
286      res->data  = (char *) (r<0);
287      break;
288    case '>':
289      res->data  = (char *) (r>0);
290      break;
291    case LE:
292      res->data  = (char *) (r<=0);
293      break;
294    case GE:
295      res->data  = (char *) (r>=0);
296      break;
297    case EQUAL_EQUAL:
298    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
299      res->data  = (char *) (r==0);
300      break;
301  }
302  jjEQUAL_REST(res,u,v);
303  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
304  return FALSE;
305}
306static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
307{
308  intvec* a = (intvec * )(u->Data());
309  int     b = (int)(long)(v->Data());
310  int r=a->compare(b);
311  switch  (iiOp)
312  {
313    case '<':
314      res->data  = (char *) (r<0);
315      break;
316    case '>':
317      res->data  = (char *) (r>0);
318      break;
319    case LE:
320      res->data  = (char *) (r<=0);
321      break;
322    case GE:
323      res->data  = (char *) (r>=0);
324      break;
325    case EQUAL_EQUAL:
326    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
327      res->data  = (char *) (r==0);
328      break;
329  }
330  jjEQUAL_REST(res,u,v);
331  return FALSE;
332}
333static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
334{
335  poly p=(poly)u->Data();
336  poly q=(poly)v->Data();
337  int r=pCmp(p,q);
338  if (r==0)
339  {
340    number h=nSub(pGetCoeff(p),pGetCoeff(q));
341    /* compare lead coeffs */
342    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
343    nDelete(&h);
344  }
345  else if (p==NULL)
346  {
347    if (q==NULL)
348    {
349      /* compare 0, 0 */
350      r=0;
351    }
352    else if(pIsConstant(q))
353    {
354      /* compare 0, const */
355      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
356    }
357  }
358  else if (q==NULL)
359  {
360    if (pIsConstant(p))
361    {
362      /* compare const, 0 */
363      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
364    }
365  }
366  switch  (iiOp)
367  {
368    case '<':
369      res->data  = (char *) (r < 0);
370      break;
371    case '>':
372      res->data  = (char *) (r > 0);
373      break;
374    case LE:
375      res->data  = (char *) (r <= 0);
376      break;
377    case GE:
378      res->data  = (char *) (r >= 0);
379      break;
380    //case EQUAL_EQUAL:
381    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
382    //  res->data  = (char *) (r == 0);
383    //  break;
384  }
385  jjEQUAL_REST(res,u,v);
386  return FALSE;
387}
388static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
389{
390  char*    a = (char * )(u->Data());
391  char*    b = (char * )(v->Data());
392  int result = strcmp(a,b);
393  switch  (iiOp)
394  {
395    case '<':
396      res->data  = (char *) (result  < 0);
397      break;
398    case '>':
399      res->data  = (char *) (result  > 0);
400      break;
401    case LE:
402      res->data  = (char *) (result  <= 0);
403      break;
404    case GE:
405      res->data  = (char *) (result  >= 0);
406      break;
407    case EQUAL_EQUAL:
408    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
409      res->data  = (char *) (result  == 0);
410      break;
411  }
412  jjEQUAL_REST(res,u,v);
413  return FALSE;
414}
415static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
416{
417  if (u->Next()!=NULL)
418  {
419    u=u->next;
420    res->next = (leftv)omAllocBin(sleftv_bin);
421    return iiExprArith2(res->next,u,iiOp,v);
422  }
423  else if (v->Next()!=NULL)
424  {
425    v=v->next;
426    res->next = (leftv)omAllocBin(sleftv_bin);
427    return iiExprArith2(res->next,u,iiOp,v);
428  }
429  return FALSE;
430}
431static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
432{
433  int b=(int)(long)u->Data();
434  int e=(int)(long)v->Data();
435  int rc = 1;
436  BOOLEAN overflow=FALSE;
437  if (e >= 0)
438  {
439    if (b==0)
440    {
441      rc=(e==0);
442    }
443    else
444    {
445      int oldrc;
446      while ((e--)!=0)
447      {
448        oldrc=rc;
449        rc *= b;
450        if (!overflow)
451        {
452          if(rc/b!=oldrc) overflow=TRUE;
453        }
454      }
455      if (overflow)
456        WarnS("int overflow(^), result may be wrong");
457    }
458    res->data = (char *)((long)rc);
459    if (u!=NULL) return jjOP_REST(res,u,v);
460    return FALSE;
461  }
462  else
463  {
464    WerrorS("exponent must be non-negative");
465    return TRUE;
466  }
467}
468static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
469{
470  int e=(int)(long)v->Data();
471  number n=(number)u->Data();
472  if (e>=0)
473  {
474    nlPower(n,e,(number*)&res->data);
475  }
476  else
477  {
478    WerrorS("exponent must be non-negative");
479    return TRUE;
480  }
481  if (u!=NULL) return jjOP_REST(res,u,v);
482  return FALSE;
483}
484static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
485{
486  int e=(int)(long)v->Data();
487  number n=(number)u->Data();
488  int d=0;
489  if (e<0)
490  {
491    n=nInvers(n);
492    e=-e;
493    d=1;
494  }
495  nPower(n,e,(number*)&res->data);
496  if (d) nDelete(&n);
497  if (u!=NULL) return jjOP_REST(res,u,v);
498  return FALSE;
499}
500static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
501{
502  int v_i=(int)(long)v->Data();
503  if (v_i<0)
504  {
505    WerrorS("exponent must be non-negative");
506    return TRUE;
507  }
508  poly u_p=(poly)u->CopyD(POLY_CMD);
509  int dummy;
510  if ((u_p!=NULL)
511  && ((v_i!=0) &&
512       (pTotaldegree(u_p) > (signed long)currRing->bitmask)/(signed long)v_i))
513  {
514    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
515                                    pTotaldegree(u_p),v_i,currRing->bitmask);
516    pDelete(&u_p);
517    return TRUE;
518  }
519  res->data = (char *)pPower(u_p,v_i);
520  if (u!=NULL) return jjOP_REST(res,u,v);
521  return errorreported; /* pPower may set errorreported via Werror */
522}
523static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
524{
525  res->data = (char *)idPower((ideal)(u->Data()),(int)(long)(v->Data()));
526  if (u!=NULL) return jjOP_REST(res,u,v);
527  return FALSE;
528}
529static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
530{
531  u=u->next;
532  v=v->next;
533  if (u==NULL)
534  {
535    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
536    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
537    {
538      do
539      {
540        if (res->next==NULL)
541          res->next = (leftv)omAlloc0Bin(sleftv_bin);
542        leftv tmp_v=v->next;
543        v->next=NULL;
544        BOOLEAN b=iiExprArith1(res->next,v,'-');
545        v->next=tmp_v;
546        if (b)
547          return TRUE;
548        v=tmp_v;
549        res=res->next;
550      } while (v!=NULL);
551      return FALSE;
552    }
553    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
554    {
555      res->next = (leftv)omAlloc0Bin(sleftv_bin);
556      res=res->next;
557      res->data = v->CopyD();
558      res->rtyp = v->Typ();
559      v=v->next;
560      if (v==NULL) return FALSE;
561    }
562  }
563  if (v!=NULL)                     /* u<>NULL, v<>NULL */
564  {
565    do
566    {
567      res->next = (leftv)omAlloc0Bin(sleftv_bin);
568      leftv tmp_u=u->next; u->next=NULL;
569      leftv tmp_v=v->next; v->next=NULL;
570      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
571      u->next=tmp_u;
572      v->next=tmp_v;
573      if (b)
574        return TRUE;
575      u=tmp_u;
576      v=tmp_v;
577      res=res->next;
578    } while ((u!=NULL) && (v!=NULL));
579    return FALSE;
580  }
581  loop                             /* u<>NULL, v==NULL */
582  {
583    res->next = (leftv)omAlloc0Bin(sleftv_bin);
584    res=res->next;
585    res->data = u->CopyD();
586    res->rtyp = u->Typ();
587    u=u->next;
588    if (u==NULL) return FALSE;
589  }
590}
591static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
592{
593  idhdl packhdl;
594  switch(u->Typ())
595  {
596      case 0:
597        Print("%s of type 'ANY'. Trying load.\n", v->name);
598        if(iiTryLoadLib(u, u->name))
599        {
600          Werror("'%s' no such package", u->name);
601          return TRUE;
602        }
603        syMake(u,u->name,NULL);
604        // else: use next case !!! no break !!!
605      case PACKAGE_CMD:
606        packhdl = (idhdl)u->data;
607        if((!IDPACKAGE(packhdl)->loaded)
608        && (IDPACKAGE(packhdl)->language > LANG_TOP))
609        {
610          Werror("'%s' not loaded", u->name);
611          return TRUE;
612        }
613        if(v->rtyp == IDHDL)
614        {
615          v->name = omStrDup(v->name);
616        }
617        v->req_packhdl=IDPACKAGE(packhdl);
618        syMake(v, v->name, packhdl);
619        memcpy(res, v, sizeof(sleftv));
620        memset(v, 0, sizeof(sleftv));
621        break;
622      case DEF_CMD:
623        break;
624      default:
625        WerrorS("<package>::<id> expected");
626        return TRUE;
627  }
628  return FALSE;
629}
630static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
631{
632  unsigned int a=(unsigned int)(unsigned long)u->Data();
633  unsigned int b=(unsigned int)(unsigned long)v->Data();
634  unsigned int c=a+b;
635  res->data = (char *)((long)c);
636  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
637  {
638    WarnS("int overflow(+), result may be wrong");
639  }
640  return jjPLUSMINUS_Gen(res,u,v);
641}
642static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
643{
644  res->data = (char *)(nlAdd((number)u->Data(), (number)v->Data()));
645  return jjPLUSMINUS_Gen(res,u,v);
646}
647static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
648{
649  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
650  return jjPLUSMINUS_Gen(res,u,v);
651}
652static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
653{
654  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
655  return jjPLUSMINUS_Gen(res,u,v);
656}
657static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
658{
659  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
660  if (res->data==NULL)
661  {
662     WerrorS("intmat size not compatible");
663     return TRUE;
664  }
665  return jjPLUSMINUS_Gen(res,u,v);
666  return FALSE;
667}
668static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
669{
670  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
671  res->data = (char *)(mpAdd(A , B));
672  if (res->data==NULL)
673  {
674     Werror("matrix size not compatible(%dx%d, %dx%d)",
675             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
676     return TRUE;
677  }
678  return jjPLUSMINUS_Gen(res,u,v);
679}
680static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
681{
682  matrix m=(matrix)u->Data();
683  matrix p= mpInitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)));
684  if (iiOp=='+')
685    res->data = (char *)mpAdd(m , p);
686  else
687    res->data = (char *)mpSub(m , p);
688  idDelete((ideal *)&p);
689  return jjPLUSMINUS_Gen(res,u,v);
690}
691static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
692{
693  return jjPLUS_MA_P(res,v,u);
694}
695static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
696{
697  char*    a = (char * )(u->Data());
698  char*    b = (char * )(v->Data());
699  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
700  strcpy(r,a);
701  strcat(r,b);
702  res->data=r;
703  return jjPLUSMINUS_Gen(res,u,v);
704}
705static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
706{
707  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
708  return jjPLUSMINUS_Gen(res,u,v);
709}
710static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
711{
712  void *ap=u->Data(); void *bp=v->Data();
713  int aa=(int)(long)ap;
714  int bb=(int)(long)bp;
715  int cc=aa-bb;
716  unsigned int a=(unsigned int)(unsigned long)ap;
717  unsigned int b=(unsigned int)(unsigned long)bp;
718  unsigned int c=a-b;
719  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
720  {
721    WarnS("int overflow(-), result may be wrong");
722  }
723  res->data = (char *)((long)cc);
724  return jjPLUSMINUS_Gen(res,u,v);
725}
726static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
727{
728  res->data = (char *)(nlSub((number)u->Data(), (number)v->Data()));
729  return jjPLUSMINUS_Gen(res,u,v);
730}
731static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
732{
733  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
734  return jjPLUSMINUS_Gen(res,u,v);
735}
736static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
737{
738  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
739  return jjPLUSMINUS_Gen(res,u,v);
740}
741static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
742{
743  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
744  if (res->data==NULL)
745  {
746     WerrorS("intmat size not compatible");
747     return TRUE;
748  }
749  return jjPLUSMINUS_Gen(res,u,v);
750}
751static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
752{
753  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
754  res->data = (char *)(mpSub(A , B));
755  if (res->data==NULL)
756  {
757     Werror("matrix size not compatible(%dx%d, %dx%d)",
758             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
759     return TRUE;
760  }
761  return jjPLUSMINUS_Gen(res,u,v);
762  return FALSE;
763}
764static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
765{
766  int a=(int)(long)u->Data();
767  int b=(int)(long)v->Data();
768  int c=a * b;
769  if ((b!=0) && (c/b !=a))
770    WarnS("int overflow(*), result may be wrong");
771  res->data = (char *)((long)c);
772  if ((u->Next()!=NULL) || (v->Next()!=NULL))
773    return jjOP_REST(res,u,v);
774  return FALSE;
775}
776static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
777{
778  res->data = (char *)(nlMult( (number)u->Data(), (number)v->Data()));
779  if ((v->next!=NULL) || (u->next!=NULL))
780    return jjOP_REST(res,u,v);
781  return FALSE;
782}
783static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
784{
785  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
786  number n=(number)res->data;
787  nNormalize(n);
788  res->data=(char *)n;
789  if ((v->next!=NULL) || (u->next!=NULL))
790    return jjOP_REST(res,u,v);
791  return FALSE;
792}
793static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
794{
795  poly a;
796  poly b;
797  int dummy;
798  if (v->next==NULL)
799  {
800    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
801    if (u->next==NULL)
802    {
803      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
804      if ((a!=NULL) && (b!=NULL)
805      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask)-(long)pTotaldegree(b)))
806      {
807        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
808          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
809        pDelete(&a);
810        pDelete(&b);
811        return TRUE;
812      }
813      res->data = (char *)(pMult( a, b));
814      pNormalize((poly)res->data);
815      return FALSE;
816    }
817    // u->next exists: copy v
818    b=pCopy((poly)v->Data());
819    if ((a!=NULL) && (b!=NULL)
820    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
821    {
822      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
823          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
824      pDelete(&a);
825      pDelete(&b);
826      return TRUE;
827    }
828    res->data = (char *)(pMult( a, b));
829    pNormalize((poly)res->data);
830    return jjOP_REST(res,u,v);
831  }
832  // v->next exists: copy u
833  a=pCopy((poly)u->Data());
834  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
835  if ((a!=NULL) && (b!=NULL)
836  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
837  {
838    pDelete(&a);
839    pDelete(&b);
840    WerrorS("OVERFLOW");
841    return TRUE;
842  }
843  res->data = (char *)(pMult( a, b));
844  pNormalize((poly)res->data);
845  return jjOP_REST(res,u,v);
846}
847static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
848{
849  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
850  idNormalize((ideal)res->data);
851  if ((v->next!=NULL) || (u->next!=NULL))
852    return jjOP_REST(res,u,v);
853  return FALSE;
854}
855static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
856{
857  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
858  if (res->data==NULL)
859  {
860     WerrorS("intmat size not compatible");
861     return TRUE;
862  }
863  if ((v->next!=NULL) || (u->next!=NULL))
864    return jjOP_REST(res,u,v);
865  return FALSE;
866}
867static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
868{
869  number n=nInit_bigint((number)v->Data());
870  poly p=pNSet(n);
871  ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
872  res->data = (char *)I;
873  return FALSE;
874}
875static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
876{
877  return jjTIMES_MA_BI1(res,v,u);
878}
879static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
880{
881  poly p=(poly)v->CopyD(POLY_CMD);
882  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
883  ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
884  if (r>0) I->rank=r;
885  idNormalize(I);
886  res->data = (char *)I;
887  return FALSE;
888}
889static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
890{
891  poly p=(poly)u->CopyD(POLY_CMD);
892  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
893  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD));
894  if (r>0) I->rank=r;
895  idNormalize(I);
896  res->data = (char *)I;
897  return FALSE;
898}
899static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
900{
901  number n=(number)v->CopyD(NUMBER_CMD);
902  poly p=pNSet(n);
903  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
904  idNormalize((ideal)res->data);
905  return FALSE;
906}
907static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
908{
909  return jjTIMES_MA_N1(res,v,u);
910}
911static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
912{
913  res->data = (char *)mpMultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data());
914  idNormalize((ideal)res->data);
915  return FALSE;
916}
917static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
918{
919  return jjTIMES_MA_I1(res,v,u);
920}
921static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
922{
923  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
924  res->data = (char *)mpMult(A,B);
925  if (res->data==NULL)
926  {
927     Werror("matrix size not compatible(%dx%d, %dx%d)",
928             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
929     return TRUE;
930  }
931  idNormalize((ideal)res->data);
932  if ((v->next!=NULL) || (u->next!=NULL))
933    return jjOP_REST(res,u,v);
934  return FALSE;
935}
936static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
937{
938  number h=nlSub((number)u->Data(),(number)v->Data());
939  res->data = (char *) (nlGreaterZero(h)||(nlIsZero(h)));
940  nlDelete(&h,NULL);
941  return FALSE;
942}
943static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
944{
945  res->data = (char *)((int)((long)u->Data()) >= (int)((long)v->Data()));
946  return FALSE;
947}
948static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
949{
950  res->data = (char *) (nGreater((number)u->Data(),(number)v->Data())
951                       || nEqual((number)u->Data(),(number)v->Data()));
952  return FALSE;
953}
954static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
955{
956  number h=nlSub((number)u->Data(),(number)v->Data());
957  res->data = (char *) (nlGreaterZero(h)&&(!nlIsZero(h)));
958  nlDelete(&h,NULL);
959  return FALSE;
960}
961static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
962{
963  res->data = (char *)((int)((long)u->Data()) > (int)((long)v->Data()));
964  return FALSE;
965}
966static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
967{
968  res->data = (char *) (nGreater((number)u->Data(),(number)v->Data()));
969  return FALSE;
970}
971static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
972{
973  return jjGE_BI(res,v,u);
974}
975static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
976{
977  res->data = (char *)((int)((long)u->Data()) <= (int)((long)v->Data()));
978  return FALSE;
979}
980static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
981{
982  return jjGE_N(res,v,u);
983}
984static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
985{
986  return jjGT_BI(res,v,u);
987}
988static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
989{
990  res->data = (char *)((int)((long)u->Data()) < (int)((long)v->Data()));
991  return FALSE;
992}
993static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
994{
995  return jjGT_N(res,v,u);
996}
997static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
998{
999  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1000  int a= (int)(long)u->Data();
1001  int b= (int)(long)v->Data();
1002  if (b==0)
1003  {
1004    WerrorS(ii_div_by_0);
1005    return TRUE;
1006  }
1007  int bb=ABS(b);
1008  int c=a%bb;
1009  if(c<0) c+=bb;
1010  int r=0;
1011  switch (iiOp)
1012  {
1013    case INTMOD_CMD:
1014        r=c;            break;
1015    case '%':
1016        r= (a % b);     break;
1017    case INTDIV_CMD:
1018        r=((a-c) /b);   break;
1019    case '/':
1020        r= (a / b);     break;
1021  }
1022  res->data=(void *)((long)r);
1023  return FALSE;
1024}
1025static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1026{
1027  number q=(number)v->Data();
1028  if (nlIsZero(q))
1029  {
1030    WerrorS(ii_div_by_0);
1031    return TRUE;
1032  }
1033  q = nlIntDiv((number)u->Data(),q);
1034  nlNormalize(q);
1035  res->data = (char *)q;
1036  return FALSE;
1037}
1038static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1039{
1040  number q=(number)v->Data();
1041  if (nIsZero(q))
1042  {
1043    WerrorS(ii_div_by_0);
1044    return TRUE;
1045  }
1046  q = nDiv((number)u->Data(),q);
1047  nNormalize(q);
1048  res->data = (char *)q;
1049  return FALSE;
1050}
1051static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1052{
1053  poly q=(poly)v->Data();
1054  if (q==NULL)
1055  {
1056    WerrorS(ii_div_by_0);
1057    return TRUE;
1058  }
1059  poly p=(poly)(u->Data());
1060  if (p==NULL)
1061  {
1062    res->data=NULL;
1063    return FALSE;
1064  }
1065  if ((pNext(q)!=NULL) && (!rField_is_Ring()))
1066  { /* This means that q != 0 consists of at least two terms.
1067       Moreover, currRing is over a field. */
1068#ifdef HAVE_FACTORY
1069    if(pGetComp(p)==0)
1070    {
1071      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1072                                         q /*(poly)(v->Data())*/ ));
1073    }
1074    else
1075    {
1076      int comps=pMaxComp(p);
1077      ideal I=idInit(comps,1);
1078      p=pCopy(p);
1079      poly h;
1080      int i;
1081      // conversion to a list of polys:
1082      while (p!=NULL)
1083      {
1084        i=pGetComp(p)-1;
1085        h=pNext(p);
1086        pNext(p)=NULL;
1087        pSetComp(p,0);
1088        I->m[i]=pAdd(I->m[i],p);
1089        p=h;
1090      }
1091      // division and conversion to vector:
1092      h=NULL;
1093      p=NULL;
1094      for(i=comps-1;i>=0;i--)
1095      {
1096        if (I->m[i]!=NULL)
1097        {
1098          h=singclap_pdivide(I->m[i],q);
1099          pSetCompP(h,i+1);
1100          p=pAdd(p,h);
1101        }
1102      }
1103      idDelete(&I);
1104      res->data=(void *)p;
1105    }
1106#else /* HAVE_FACTORY */
1107    WerrorS("division only by a monomial");
1108    return TRUE;
1109#endif /* HAVE_FACTORY */
1110  }
1111  else
1112  { /* This means that q != 0 consists of just one term,
1113       or that currRing is over a coefficient ring. */
1114#ifdef HAVE_RINGS
1115    if (!rField_is_Domain())
1116    {
1117      WerrorS("division only defined over coefficient domains");
1118      return TRUE;
1119    }
1120    if (pNext(q)!=NULL)
1121    {
1122      WerrorS("division over a coefficient domain only implemented for terms");
1123      return TRUE;
1124    }
1125#endif
1126    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1127  }
1128  pNormalize((poly)res->data);
1129  return FALSE;
1130}
1131static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1132{
1133  poly q=(poly)v->Data();
1134  if (q==NULL)
1135  {
1136    WerrorS(ii_div_by_0);
1137    return TRUE;
1138  }
1139  matrix m=(matrix)(u->Data());
1140  int r=m->rows();
1141  int c=m->cols();
1142  matrix mm=mpNew(r,c);
1143  int i,j;
1144  for(i=r;i>0;i--)
1145  {
1146    for(j=c;j>0;j--)
1147    {
1148      if (pNext(q)!=NULL)
1149      {
1150      #ifdef HAVE_FACTORY
1151        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1152                                           q /*(poly)(v->Data())*/ );
1153#else /* HAVE_FACTORY */
1154        WerrorS("division only by a monomial");
1155        return TRUE;
1156#endif /* HAVE_FACTORY */
1157      }
1158      else
1159        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1160    }
1161  }
1162  idNormalize((ideal)mm);
1163  res->data=(char *)mm;
1164  return FALSE;
1165}
1166static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1167{
1168  res->data = (char *)((long)nlEqual((number)u->Data(),(number)v->Data()));
1169  jjEQUAL_REST(res,u,v);
1170  return FALSE;
1171}
1172static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1173{
1174  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1175  jjEQUAL_REST(res,u,v);
1176  return FALSE;
1177}
1178static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1179{
1180  res->data = (char *)((long)mpEqual((matrix)u->Data(),(matrix)v->Data()));
1181  jjEQUAL_REST(res,u,v);
1182  return FALSE;
1183}
1184static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1185{
1186  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1187  jjEQUAL_REST(res,u,v);
1188  return FALSE;
1189}
1190static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1191{
1192  poly p=(poly)u->Data();
1193  poly q=(poly)v->Data();
1194  res->data = (char *) ((long)pEqualPolys(p,q));
1195  jjEQUAL_REST(res,u,v);
1196  return FALSE;
1197}
1198static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1199{
1200  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1201  {
1202    int save_iiOp=iiOp;
1203    if (iiOp==NOTEQUAL)
1204      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1205    else
1206      iiExprArith2(res,u->next,iiOp,v->next);
1207    iiOp=save_iiOp;
1208  }
1209  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1210}
1211static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1212{
1213  res->data = (char *)((long)u->Data() && (long)v->Data());
1214  return FALSE;
1215}
1216static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1217{
1218  res->data = (char *)((long)u->Data() || (long)v->Data());
1219  return FALSE;
1220}
1221static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1222{
1223  res->rtyp=u->rtyp; u->rtyp=0;
1224  res->data=u->data; u->data=NULL;
1225  res->name=u->name; u->name=NULL;
1226  res->e=u->e;       u->e=NULL;
1227  if (res->e==NULL) res->e=jjMakeSub(v);
1228  else
1229  {
1230    Subexpr sh=res->e;
1231    while (sh->next != NULL) sh=sh->next;
1232    sh->next=jjMakeSub(v);
1233  }
1234  return FALSE;
1235}
1236static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1237{
1238  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1239  {
1240    WerrorS("indexed object must have a name");
1241    return TRUE;
1242  }
1243  intvec * iv=(intvec *)v->Data();
1244  leftv p=NULL;
1245  int i;
1246  sleftv t;
1247  memset(&t,0,sizeof(t));
1248  t.rtyp=INT_CMD;
1249  for (i=0;i<iv->length(); i++)
1250  {
1251    t.data=(char *)((long)(*iv)[i]);
1252    if (p==NULL)
1253    {
1254      p=res;
1255    }
1256    else
1257    {
1258      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1259      p=p->next;
1260    }
1261    p->rtyp=IDHDL;
1262    p->data=u->data;
1263    p->name=u->name;
1264    p->flag=u->flag;
1265    p->e=jjMakeSub(&t);
1266  }
1267  u->rtyp=0;
1268  u->data=NULL;
1269  u->name=NULL;
1270  return FALSE;
1271}
1272static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1273{
1274  poly p=(poly)u->Data();
1275  int i=(int)(long)v->Data();
1276  int j=0;
1277  while (p!=NULL)
1278  {
1279    j++;
1280    if (j==i)
1281    {
1282      res->data=(char *)pHead(p);
1283      return FALSE;
1284    }
1285    pIter(p);
1286  }
1287  return FALSE;
1288}
1289static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1290{
1291  poly p=(poly)u->Data();
1292  poly r=NULL;
1293  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1294  int i;
1295  int sum=0;
1296  for(i=iv->length()-1;i>=0;i--)
1297    sum+=(*iv)[i];
1298  int j=0;
1299  while ((p!=NULL) && (sum>0))
1300  {
1301    j++;
1302    for(i=iv->length()-1;i>=0;i--)
1303    {
1304      if (j==(*iv)[i])
1305      {
1306        r=pAdd(r,pHead(p));
1307        sum-=j;
1308        (*iv)[i]=0;
1309        break;
1310      }
1311    }
1312    pIter(p);
1313  }
1314  delete iv;
1315  res->data=(char *)r;
1316  return FALSE;
1317}
1318static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1319{
1320  poly p=(poly)u->CopyD(VECTOR_CMD);
1321  poly r=p; // pointer to the beginning of component i
1322  poly o=NULL;
1323  int i=(int)(long)v->Data();
1324  while (p!=NULL)
1325  {
1326    if (pGetComp(p)!=i)
1327    {
1328      if (r==p) r=pNext(p);
1329      if (o!=NULL)
1330      {
1331        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1332        p=pNext(o);
1333      }
1334      else
1335        pLmDelete(&p);
1336    }
1337    else
1338    {
1339      pSetComp(p, 0);
1340      p_SetmComp(p, currRing);
1341      o=p;
1342      p=pNext(o);
1343    }
1344  }
1345  res->data=(char *)r;
1346  return FALSE;
1347}
1348static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1349{
1350  poly p=(poly)u->CopyD(VECTOR_CMD);
1351  if (p!=NULL)
1352  {
1353    poly r=pOne();
1354    poly hp=r;
1355    intvec *iv=(intvec *)v->Data();
1356    int i;
1357    loop
1358    {
1359      for(i=0;i<iv->length();i++)
1360      {
1361        if (pGetComp(p)==(*iv)[i])
1362        {
1363          poly h;
1364          pSplit(p,&h);
1365          pNext(hp)=p;
1366          p=h;
1367          pIter(hp);
1368          break;
1369        }
1370      }
1371      if (p==NULL) break;
1372      if (i==iv->length())
1373      {
1374        pLmDelete(&p);
1375        if (p==NULL) break;
1376      }
1377    }
1378    pLmDelete(&r);
1379    res->data=(char *)r;
1380  }
1381  return FALSE;
1382}
1383static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1384static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1385{
1386  if(u->name==NULL) return TRUE;
1387  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1388  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1389  omFree((ADDRESS)u->name);
1390  u->name=NULL;
1391  char *n=omStrDup(nn);
1392  omFree((ADDRESS)nn);
1393  syMake(res,n);
1394  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1395  return FALSE;
1396}
1397static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1398{
1399  intvec * iv=(intvec *)v->Data();
1400  leftv p=NULL;
1401  int i;
1402  long slen = strlen(u->name) + 14;
1403  char *n = (char*) omAlloc(slen);
1404
1405  for (i=0;i<iv->length(); i++)
1406  {
1407    if (p==NULL)
1408    {
1409      p=res;
1410    }
1411    else
1412    {
1413      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1414      p=p->next;
1415    }
1416    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1417    syMake(p,omStrDup(n));
1418  }
1419  omFree((ADDRESS)u->name);
1420  u->name = NULL;
1421  omFreeSize(n, slen);
1422  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1423  return FALSE;
1424}
1425static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1426{
1427  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1428  memset(tmp,0,sizeof(sleftv));
1429  BOOLEAN b;
1430  if (v->Typ()==INTVEC_CMD)
1431    b=jjKLAMMER_IV(tmp,u,v);
1432  else
1433    b=jjKLAMMER(tmp,u,v);
1434  if (b)
1435  {
1436    omFreeBin(tmp,sleftv_bin);
1437    return TRUE;
1438  }
1439  leftv h=res;
1440  while (h->next!=NULL) h=h->next;
1441  h->next=tmp;
1442  return FALSE;
1443}
1444BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1445{
1446  void *d;
1447  Subexpr e;
1448  int typ;
1449  BOOLEAN t=FALSE;
1450  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1451  {
1452    idrec tmp_proc;
1453    tmp_proc.id="_auto";
1454    tmp_proc.typ=PROC_CMD;
1455    tmp_proc.data.pinf=(procinfo *)u->Data();
1456    tmp_proc.ref=1;
1457    d=u->data; u->data=(void *)&tmp_proc;
1458    e=u->e; u->e=NULL;
1459    t=TRUE;
1460    typ=u->rtyp; u->rtyp=IDHDL;
1461  }
1462  leftv sl;
1463  if (u->req_packhdl==currPack)
1464    sl = iiMake_proc((idhdl)u->data,NULL,v);
1465  else
1466    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1467  if (t)
1468  {
1469    u->rtyp=typ;
1470    u->data=d;
1471    u->e=e;
1472  }
1473  if (sl==NULL)
1474  {
1475    return TRUE;
1476  }
1477  else
1478  {
1479    memcpy(res,sl,sizeof(sleftv));
1480  }
1481  return FALSE;
1482}
1483static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1484{
1485  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1486  leftv sl=NULL;
1487  if ((v->e==NULL)&&(v->name!=NULL))
1488  {
1489    map m=(map)u->Data();
1490    sl=iiMap(m,v->name);
1491  }
1492  else
1493  {
1494    Werror("%s(<name>) expected",u->Name());
1495  }
1496  if (sl==NULL) return TRUE;
1497  memcpy(res,sl,sizeof(sleftv));
1498  omFreeBin((ADDRESS)sl, sleftv_bin);
1499  return FALSE;
1500}
1501static BOOLEAN jjCALL2MANY(leftv res, leftv u, leftv v)
1502{
1503  u->next=(leftv)omAllocBin(sleftv_bin);
1504  memcpy(u->next,v,sizeof(sleftv));
1505  BOOLEAN r=iiExprArithM(res,u,iiOp);
1506  v->Init();
1507  // iiExprArithM did the CleanUp
1508  return r;
1509}
1510#ifdef HAVE_FACTORY
1511static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1512{
1513  intvec *c=(intvec*)u->Data();
1514  intvec* p=(intvec*)v->Data();
1515  int rl=p->length();
1516  number *x=(number *)omAlloc(rl*sizeof(number));
1517  number *q=(number *)omAlloc(rl*sizeof(number));
1518  int i;
1519  for(i=rl-1;i>=0;i--)
1520  {
1521    q[i]=nlInit((*p)[i], NULL);
1522    x[i]=nlInit((*c)[i], NULL);
1523  }
1524  number n=nlChineseRemainder(x,q,rl);
1525  for(i=rl-1;i>=0;i--)
1526  {
1527    nlDelete(&(q[i]),NULL);
1528    nlDelete(&(x[i]),NULL);
1529  }
1530  omFree(x); omFree(q);
1531  res->data=(char *)n;
1532  return FALSE;
1533}
1534#endif
1535#if 0
1536static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1537{
1538  lists c=(lists)u->CopyD(); // list of poly
1539  intvec* p=(intvec*)v->Data();
1540  int rl=p->length();
1541  poly r=NULL,h, result=NULL;
1542  number *x=(number *)omAlloc(rl*sizeof(number));
1543  number *q=(number *)omAlloc(rl*sizeof(number));
1544  int i;
1545  for(i=rl-1;i>=0;i--)
1546  {
1547    q[i]=nlInit((*p)[i]);
1548  }
1549  loop
1550  {
1551    for(i=rl-1;i>=0;i--)
1552    {
1553      if (c->m[i].Typ()!=POLY_CMD)
1554      {
1555        Werror("poly expected at pos %d",i+1);
1556        for(i=rl-1;i>=0;i--)
1557        {
1558          nlDelete(&(q[i]),currRing);
1559        }
1560        omFree(x); omFree(q); // delete c
1561        return TRUE;
1562      }
1563      h=((poly)c->m[i].Data());
1564      if (r==NULL) r=h;
1565      else if (pLmCmp(r,h)==-1) r=h;
1566    }
1567    if (r==NULL) break;
1568    for(i=rl-1;i>=0;i--)
1569    {
1570      h=((poly)c->m[i].Data());
1571      if (pLmCmp(r,h)==0)
1572      {
1573        x[i]=pGetCoeff(h);
1574        h=pLmFreeAndNext(h);
1575        c->m[i].data=(char*)h;
1576      }
1577      else
1578        x[i]=nlInit(0);
1579    }
1580    number n=nlChineseRemainder(x,q,rl);
1581    for(i=rl-1;i>=0;i--)
1582    {
1583      nlDelete(&(x[i]),currRing);
1584    }
1585    h=pHead(r);
1586    pSetCoeff(h,n);
1587    result=pAdd(result,h);
1588  }
1589  for(i=rl-1;i>=0;i--)
1590  {
1591    nlDelete(&(q[i]),currRing);
1592  }
1593  omFree(x); omFree(q);
1594  res->data=(char *)result;
1595  return FALSE;
1596}
1597#endif
1598#ifdef HAVE_FACTORY
1599static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1600{
1601  if ((currRing==NULL) || rField_is_Q())
1602  {
1603    lists c=(lists)u->CopyD(); // list of ideal
1604    lists pl=NULL;
1605    intvec *p=NULL;
1606    if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1607    else                    p=(intvec*)v->Data();
1608    int rl=c->nr+1;
1609    poly r=NULL,h;
1610    ideal result;
1611    ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1612    int i;
1613    int return_type=c->m[0].Typ();
1614    if ((return_type!=IDEAL_CMD)
1615    && (return_type!=MODUL_CMD)
1616    && (return_type!=MATRIX_CMD))
1617    {
1618      WerrorS("ideal/module/matrix expected");
1619      omFree(x); // delete c
1620      return TRUE;
1621    }
1622    for(i=rl-1;i>=0;i--)
1623    {
1624      if (c->m[i].Typ()!=return_type)
1625      {
1626        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1627        omFree(x); // delete c
1628        return TRUE;
1629      }
1630      x[i]=((ideal)c->m[i].Data());
1631    }
1632    number *q=(number *)omAlloc(rl*sizeof(number));
1633    if (p!=NULL)
1634    {
1635      for(i=rl-1;i>=0;i--)
1636      {
1637        q[i]=nlInit((*p)[i], currRing);
1638      }
1639    }
1640    else
1641    {
1642      for(i=rl-1;i>=0;i--)
1643      {
1644        if (pl->m[i].Typ()==INT_CMD)
1645        {
1646          q[i]=nlInit((int)(long)pl->m[i].Data(),currRing);
1647        }
1648        else if (pl->m[i].Typ()==BIGINT_CMD)
1649        {
1650          q[i]=nlCopy((number)(pl->m[i].Data()));
1651        }
1652        else
1653        {
1654          Werror("bigint expected at pos %d",i+1);
1655          for(i++;i<rl;i++)
1656          {
1657            nlDelete(&(q[i]),currRing);
1658          }
1659          omFree(x); // delete c
1660          omFree(q); // delete pl
1661          return TRUE;
1662        }
1663      }
1664    }
1665    result=idChineseRemainder(x,q,rl);
1666    for(i=rl-1;i>=0;i--)
1667    {
1668      nlDelete(&(q[i]),currRing);
1669    }
1670    omFree(q);
1671    res->data=(char *)result;
1672    res->rtyp=return_type;
1673    return FALSE;
1674  }
1675  else return TRUE;
1676}
1677#endif
1678static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1679{
1680  poly p=(poly)v->Data();
1681  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1682  res->data=(char *)mpCoeffProc((poly)u->Data(),p /*(poly)v->Data()*/);
1683  return FALSE;
1684}
1685static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1686{
1687  int i=pVar((poly)v->Data());
1688  if (i==0)
1689  {
1690    WerrorS("ringvar expected");
1691    return TRUE;
1692  }
1693  res->data=(char *)mpCoeffs((ideal)u->CopyD(),i);
1694  return FALSE;
1695}
1696static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1697{
1698  poly p = pInit();
1699  int i;
1700  for (i=1; i<=pVariables; i++)
1701  {
1702    pSetExp(p, i, 1);
1703  }
1704  pSetm(p);
1705  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1706                                    (ideal)(v->Data()), p);
1707  pDelete(&p);
1708  return FALSE;
1709}
1710static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1711{
1712  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1713  return FALSE;
1714}
1715static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1716{
1717  short *iv=iv2array((intvec *)v->Data());
1718  ideal I=(ideal)u->Data();
1719  int d=-1;
1720  int i;
1721  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1722  omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1723  res->data = (char *)((long)d);
1724  return FALSE;
1725}
1726static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1727{
1728  poly p=(poly)u->Data();
1729  if (p!=NULL)
1730  {
1731    short *iv=iv2array((intvec *)v->Data());
1732    int d=(int)pDegW(p,iv);
1733    omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1734    res->data = (char *)(long(d));
1735  }
1736  else
1737    res->data=(char *)(long)(-1);
1738  return FALSE;
1739}
1740static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1741{
1742  int i=pVar((poly)v->Data());
1743  if (i==0)
1744  {
1745    WerrorS("ringvar expected");
1746    return TRUE;
1747  }
1748  res->data=(char *)pDiff((poly)(u->Data()),i);
1749  return FALSE;
1750}
1751static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1752{
1753  int i=pVar((poly)v->Data());
1754  if (i==0)
1755  {
1756    WerrorS("ringvar expected");
1757    return TRUE;
1758  }
1759  res->data=(char *)idDiff((matrix)(u->Data()),i);
1760  return FALSE;
1761}
1762static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1763{
1764  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1765  return FALSE;
1766}
1767static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1768{
1769  assumeStdFlag(v);
1770#ifdef HAVE_RINGS
1771  if (rField_is_Ring(currRing))
1772  {
1773    ring origR = currRing;
1774    ring tempR = rCopy(origR);
1775    tempR->ringtype = 0; tempR->ch = 0;
1776    rComplete(tempR);
1777    ideal vid = (ideal)v->Data();
1778    int i = idPosConstant(vid);
1779    if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
1780    { /* ideal v contains unit; dim = -1 */
1781      res->data = (char *)-1;
1782      return FALSE;
1783    }
1784    rChangeCurrRing(tempR);
1785    ideal vv = idrCopyR(vid, origR, currRing);
1786    ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1787    /* drop degree zero generator from vv (if any) */
1788    if (i != -1) pDelete(&vv->m[i]);
1789    long d = (long)scDimInt(vv, ww);
1790    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
1791    res->data = (char *)d;
1792    idDelete(&vv); idDelete(&ww);
1793    rChangeCurrRing(origR);
1794    rDelete(tempR);
1795    return FALSE;
1796  }
1797#endif
1798  if(currQuotient==NULL)
1799    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1800  else
1801  {
1802    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1803    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1804    idDelete(&q);
1805  }
1806  return FALSE;
1807}
1808static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1809{
1810  ideal vi=(ideal)v->Data();
1811  int vl= IDELEMS(vi);
1812  ideal ui=(ideal)u->Data();
1813  int ul= IDELEMS(ui);
1814  ideal R; matrix U;
1815  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1816  if (m==NULL) return TRUE;
1817  // now make sure that all matices have the corect size:
1818  matrix T = idModule2formatedMatrix(m,vl,ul);
1819  int i;
1820  if (MATCOLS(U) != ul)
1821  {
1822    int mul=si_min(ul,MATCOLS(U));
1823    matrix UU=mpNew(ul,ul);
1824    int j;
1825    for(i=mul;i>0;i--)
1826    {
1827      for(j=mul;j>0;j--)
1828      {
1829        MATELEM(UU,i,j)=MATELEM(U,i,j);
1830        MATELEM(U,i,j)=NULL;
1831      }
1832    }
1833    idDelete((ideal *)&U);
1834    U=UU;
1835  }
1836  // make sure that U is a diagonal matrix of units
1837  for(i=ul;i>0;i--)
1838  {
1839    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1840  }
1841  lists L=(lists)omAllocBin(slists_bin);
1842  L->Init(3);
1843  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1844  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1845  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1846  res->data=(char *)L;
1847  return FALSE;
1848}
1849static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1850{
1851  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1852  //setFlag(res,FLAG_STD);
1853  return FALSE;
1854}
1855static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1856{
1857  poly p=pOne();
1858  intvec *iv=(intvec*)v->Data();
1859  for(int i=iv->length()-1; i>=0; i--)
1860  {
1861    pSetExp(p,(*iv)[i],1);
1862  }
1863  pSetm(p);
1864  res->data=(char *)idElimination((ideal)u->Data(),p);
1865  pLmDelete(&p);
1866  //setFlag(res,FLAG_STD);
1867  return FALSE;
1868}
1869static BOOLEAN jjEXPORTTO(leftv res, leftv u, leftv v)
1870{
1871  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1872  return iiExport(v,0,(idhdl)u->data);
1873}
1874static BOOLEAN jjERROR(leftv res, leftv u)
1875{
1876  WerrorS((char *)u->Data());
1877  extern int inerror;
1878  inerror=3;
1879  return TRUE;
1880}
1881static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1882{
1883  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1884  int p0=ABS(uu),p1=ABS(vv);
1885  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1886
1887  while ( p1!=0 )
1888  {
1889    q=p0 / p1;
1890    r=p0 % p1;
1891    p0 = p1; p1 = r;
1892    r = g0 - g1 * q;
1893    g0 = g1; g1 = r;
1894    r = f0 - f1 * q;
1895    f0 = f1; f1 = r;
1896  }
1897  int a = f0;
1898  int b = g0;
1899  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
1900  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
1901  lists L=(lists)omAllocBin(slists_bin);
1902  L->Init(3);
1903  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
1904  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
1905  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
1906  res->rtyp=LIST_CMD;
1907  res->data=(char *)L;
1908  return FALSE;
1909}
1910#ifdef HAVE_FACTORY
1911static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
1912{
1913  poly r,pa,pb;
1914  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb);
1915  if (ret) return TRUE;
1916  lists L=(lists)omAllocBin(slists_bin);
1917  L->Init(3);
1918  res->data=(char *)L;
1919  L->m[0].data=(void *)r;
1920  L->m[0].rtyp=POLY_CMD;
1921  L->m[1].data=(void *)pa;
1922  L->m[1].rtyp=POLY_CMD;
1923  L->m[2].data=(void *)pb;
1924  L->m[2].rtyp=POLY_CMD;
1925  return FALSE;
1926}
1927extern int singclap_factorize_retry;
1928static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
1929{
1930  intvec *v=NULL;
1931  int sw=(int)(long)dummy->Data();
1932  int fac_sw=sw;
1933  if ((sw<0)||(sw>2)) fac_sw=1;
1934  singclap_factorize_retry=0;
1935  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw);
1936  if (f==NULL)
1937    return TRUE;
1938  switch(sw)
1939  {
1940    case 0:
1941    case 2:
1942    {
1943      lists l=(lists)omAllocBin(slists_bin);
1944      l->Init(2);
1945      l->m[0].rtyp=IDEAL_CMD;
1946      l->m[0].data=(void *)f;
1947      l->m[1].rtyp=INTVEC_CMD;
1948      l->m[1].data=(void *)v;
1949      res->data=(void *)l;
1950      res->rtyp=LIST_CMD;
1951      return FALSE;
1952    }
1953    case 1:
1954      res->data=(void *)f;
1955      return FALSE;
1956    case 3:
1957      {
1958        poly p=f->m[0];
1959        int i=IDELEMS(f);
1960        f->m[0]=NULL;
1961        while(i>1)
1962        {
1963          i--;
1964          p=pMult(p,f->m[i]);
1965          f->m[i]=NULL;
1966        }
1967        res->data=(void *)p;
1968        res->rtyp=POLY_CMD;
1969      }
1970      return FALSE;
1971  }
1972  WerrorS("invalid switch");
1973  return TRUE;
1974}
1975static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
1976{
1977  ideal_list p,h;
1978  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
1979  p=h;
1980  int l=0;
1981  while (p!=NULL) { p=p->next;l++; }
1982  lists L=(lists)omAllocBin(slists_bin);
1983  L->Init(l);
1984  l=0;
1985  while(h!=NULL)
1986  {
1987    L->m[l].data=(char *)h->d;
1988    L->m[l].rtyp=IDEAL_CMD;
1989    p=h->next;
1990    omFreeSize(h,sizeof(*h));
1991    h=p;
1992    l++;
1993  }
1994  res->data=(void *)L;
1995  return FALSE;
1996}
1997#endif /* HAVE_FACTORY */
1998static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
1999{
2000  if (rField_is_Q())
2001  {
2002    number uu=(number)u->Data();
2003    number vv=(number)v->Data();
2004    res->data=(char *)nlFarey(uu,vv);
2005    return FALSE;
2006  }
2007  else return TRUE;
2008}
2009static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2010{
2011  if (rField_is_Q())
2012  {
2013    ideal uu=(ideal)u->Data();
2014    number vv=(number)v->Data();
2015    res->data=(void*)idFarey(uu,vv);
2016    res->rtyp=u->Typ();
2017    return FALSE;
2018  }
2019  else return TRUE;
2020}
2021static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2022{
2023  ring r=(ring)u->Data();
2024  idhdl w;
2025  int op=iiOp;
2026  nMapFunc nMap;
2027
2028  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2029  {
2030    int *perm=NULL;
2031    int *par_perm=NULL;
2032    int par_perm_size=0;
2033    BOOLEAN bo;
2034    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2035    if ((nMap=nSetMap(r))==NULL)
2036    {
2037      if (rEqual(r,currRing))
2038      {
2039        nMap=nCopy;
2040      }
2041      else
2042      // Allow imap/fetch to be make an exception only for:
2043      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2044            (rField_is_Q() || rField_is_Q_a() ||
2045             (rField_is_Zp() || rField_is_Zp_a())))
2046           ||
2047           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2048            (rField_is_Zp(currRing, rInternalChar(r)) ||
2049             rField_is_Zp_a(currRing, rInternalChar(r)))) )
2050      {
2051        par_perm_size=rPar(r);
2052        BITSET save_test=test;
2053        if ((r->minpoly != NULL) || (r->minideal != NULL))
2054          naSetChar(rInternalChar(r),r);
2055        else naSetChar(rInternalChar(r),r);
2056        nSetChar(currRing);
2057        test=save_test;
2058      }
2059      else
2060      {
2061        goto err_fetch;
2062      }
2063    }
2064    if ((iiOp!=FETCH_CMD) || (r->N!=pVariables) || (rPar(r)!=rPar(currRing)))
2065    {
2066      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2067      if (par_perm_size!=0)
2068        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2069      op=IMAP_CMD;
2070      if (iiOp==IMAP_CMD)
2071      {
2072        maFindPerm(r->names,       r->N,       r->parameter,        r->P,
2073                   currRing->names,currRing->N,currRing->parameter, currRing->P,
2074                   perm,par_perm, currRing->ch);
2075      }
2076      else
2077      {
2078        int i;
2079        if (par_perm_size!=0)
2080          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2081        for(i=si_min(r->N,pVariables);i>0;i--) perm[i]=i;
2082      }
2083    }
2084    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2085    {
2086      int i;
2087      for(i=0;i<si_min(r->N,pVariables);i++)
2088      {
2089        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2090      }
2091      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2092      {
2093        Print("// par nr %d: %s -> %s\n",
2094              i,r->parameter[i],currRing->parameter[i]);
2095      }
2096    }
2097    sleftv tmpW;
2098    memset(&tmpW,0,sizeof(sleftv));
2099    tmpW.rtyp=IDTYP(w);
2100    tmpW.data=IDDATA(w);
2101    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2102                         perm,par_perm,par_perm_size,nMap)))
2103    {
2104      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2105    }
2106    if (perm!=NULL)
2107      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2108    if (par_perm!=NULL)
2109      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2110    return bo;
2111  }
2112  else
2113  {
2114    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2115  }
2116  return TRUE;
2117err_fetch:
2118  Werror("no identity map from %s",u->Fullname());
2119  return TRUE;
2120}
2121static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2122{
2123  /*4
2124  * look for the substring what in the string where
2125  * return the position of the first char of what in where
2126  * or 0
2127  */
2128  char *where=(char *)u->Data();
2129  char *what=(char *)v->Data();
2130  char *found = strstr(where,what);
2131  if (found != NULL)
2132  {
2133    res->data=(char *)((found-where)+1);
2134  }
2135  /*else res->data=NULL;*/
2136  return FALSE;
2137}
2138static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2139{
2140  res->data=(char *)fractalWalkProc(u,v);
2141  setFlag( res, FLAG_STD );
2142  return FALSE;
2143}
2144static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2145{
2146  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2147  int p0=ABS(uu),p1=ABS(vv);
2148  int r;
2149  while ( p1!=0 )
2150  {
2151    r=p0 % p1;
2152    p0 = p1; p1 = r;
2153  }
2154  res->rtyp=INT_CMD;
2155  res->data=(char *)(long)p0;
2156  return FALSE;
2157}
2158static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2159{
2160  number a=(number) u->Data();
2161  number b=(number) v->Data();
2162  if (nlIsZero(a))
2163  {
2164    if (nlIsZero(b)) res->data=(char *)nlInit(1, NULL);
2165    else             res->data=(char *)nlCopy(b);
2166  }
2167  else
2168  {
2169    if (nlIsZero(b))  res->data=(char *)nlCopy(a);
2170    else res->data=(char *)nlGcd(a, b, NULL);
2171  }
2172  return FALSE;
2173}
2174static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2175{
2176  number a=(number) u->Data();
2177  number b=(number) v->Data();
2178  if (nIsZero(a))
2179  {
2180    if (nIsZero(b)) res->data=(char *)nInit(1);
2181    else            res->data=(char *)nCopy(b);
2182  }
2183  else
2184  {
2185    if (nIsZero(b))  res->data=(char *)nCopy(a);
2186    else res->data=(char *)nGcd(a, b, currRing);
2187  }
2188  return FALSE;
2189}
2190#ifdef HAVE_FACTORY
2191static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2192{
2193  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2194                                 (poly)(v->CopyD(POLY_CMD)));
2195  return FALSE;
2196}
2197#endif /* HAVE_FACTORY */
2198static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2199{
2200#ifdef HAVE_RINGS
2201  if (rField_is_Ring_Z(currRing))
2202  {
2203    ring origR = currRing;
2204    ring tempR = rCopy(origR);
2205    tempR->ringtype = 0; tempR->ch = 0;
2206    rComplete(tempR);
2207    ideal uid = (ideal)u->Data();
2208    rChangeCurrRing(tempR);
2209    ideal uu = idrCopyR(uid, origR, currRing);
2210    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2211    uuAsLeftv.rtyp = IDEAL_CMD;
2212    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2213    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2214    assumeStdFlag(&uuAsLeftv);
2215    Print("// NOTE: computation of Hilbert series etc. is being\n");
2216    Print("//       performed for generic fibre, that is, over Q\n");
2217    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2218    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2219    int returnWithTrue = 1;
2220    switch((int)(long)v->Data())
2221    {
2222      case 1:
2223        res->data=(void *)iv;
2224        returnWithTrue = 0;
2225      case 2:
2226        res->data=(void *)hSecondSeries(iv);
2227        delete iv;
2228        returnWithTrue = 0;
2229    }
2230    if (returnWithTrue)
2231    {
2232      WerrorS(feNotImplemented);
2233      delete iv;
2234    }
2235    idDelete(&uu);
2236    rChangeCurrRing(origR);
2237    rDelete(tempR);
2238    if (returnWithTrue) return TRUE; else return FALSE;
2239  }
2240#endif
2241  assumeStdFlag(u);
2242  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2243  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2244  switch((int)(long)v->Data())
2245  {
2246    case 1:
2247      res->data=(void *)iv;
2248      return FALSE;
2249    case 2:
2250      res->data=(void *)hSecondSeries(iv);
2251      delete iv;
2252      return FALSE;
2253  }
2254  WerrorS(feNotImplemented);
2255  delete iv;
2256  return TRUE;
2257}
2258static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2259{
2260  int i=pVar((poly)v->Data());
2261  if (i==0)
2262  {
2263    WerrorS("ringvar expected");
2264    return TRUE;
2265  }
2266  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2267  int d=pWTotaldegree(p);
2268  pLmDelete(p);
2269  if (d==1)
2270    res->data = (char *)pHomogen((poly)u->Data(),i);
2271  else
2272    WerrorS("variable must have weight 1");
2273  return (d!=1);
2274}
2275static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2276{
2277  int i=pVar((poly)v->Data());
2278  if (i==0)
2279  {
2280    WerrorS("ringvar expected");
2281    return TRUE;
2282  }
2283  pFDegProc deg;
2284  if (pLexOrder && (currRing->order[0]==ringorder_lp))
2285    deg=p_Totaldegree;
2286   else
2287    deg=pFDeg;
2288  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2289  int d=deg(p,currRing);
2290  pLmDelete(p);
2291  if (d==1)
2292    res->data = (char *)idHomogen((ideal)u->Data(),i);
2293  else
2294    WerrorS("variable must have weight 1");
2295  return (d!=1);
2296}
2297static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2298{
2299  intvec *w=new intvec(rVar(currRing));
2300  intvec *vw=(intvec*)u->Data();
2301  ideal v_id=(ideal)v->Data();
2302  pFDegProc save_FDeg=pFDeg;
2303  pLDegProc save_LDeg=pLDeg;
2304  BOOLEAN save_pLexOrder=pLexOrder;
2305  pLexOrder=FALSE;
2306  kHomW=vw;
2307  kModW=w;
2308  pSetDegProcs(kHomModDeg);
2309  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2310  pLexOrder=save_pLexOrder;
2311  kHomW=NULL;
2312  kModW=NULL;
2313  pRestoreDegProcs(save_FDeg,save_LDeg);
2314  if (w!=NULL) delete w;
2315  return FALSE;
2316}
2317static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2318{
2319  assumeStdFlag(u);
2320  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2321                    currQuotient);
2322  return FALSE;
2323}
2324static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2325{
2326  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2327  setFlag(res,FLAG_STD);
2328  return FALSE;
2329}
2330static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2331{
2332  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2333}
2334static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2335{
2336  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2337  return FALSE;
2338}
2339static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2340{
2341  res->data = (char *)idJet((ideal)u->Data(),(int)(long)v->Data());
2342  return FALSE;
2343}
2344static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2345{
2346  assumeStdFlag(u);
2347  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2348  res->data = (char *)scKBase((int)(long)v->Data(),
2349                              (ideal)(u->Data()),currQuotient, w_u);
2350  if (w_u!=NULL)
2351  {
2352    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2353  }
2354  return FALSE;
2355}
2356static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2357static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2358{
2359  return jjPREIMAGE(res,u,v,NULL);
2360}
2361static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2362{
2363  return mpKoszul(res, u,v);
2364}
2365static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2366{
2367  sleftv h;
2368  memset(&h,0,sizeof(sleftv));
2369  h.rtyp=INT_CMD;
2370  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2371  return mpKoszul(res, u, &h, v);
2372}
2373static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2374{
2375  BITSET save_test=test;
2376  int ul= IDELEMS((ideal)u->Data());
2377  int vl= IDELEMS((ideal)v->Data());
2378  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2379                   hasFlag(u,FLAG_STD));
2380  if (m==NULL) return TRUE;
2381  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
2382  test=save_test;
2383  return FALSE;
2384}
2385static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2386{
2387  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2388  idhdl h=(idhdl)v->data;
2389  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2390  res->data = (char *)idLiftStd((ideal)u->Data(),
2391                                &(h->data.umatrix),testHomog);
2392  setFlag(res,FLAG_STD); v->flag=0;
2393  return FALSE;
2394}
2395static BOOLEAN jjLOAD2(leftv res, leftv u,leftv v)
2396{
2397  return jjLOAD(res, v,TRUE);
2398}
2399static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2400{
2401  char * s=(char *)u->Data();
2402  if(strcmp(s, "with")==0)
2403    return jjLOAD(res, v, TRUE);
2404  WerrorS("invalid second argument");
2405  WerrorS("load(\"libname\" [,\"with\"]);");
2406  return TRUE;
2407}
2408static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2409{
2410  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2411  tHomog hom=testHomog;
2412  if (w_u!=NULL)
2413  {
2414    w_u=ivCopy(w_u);
2415    hom=isHomog;
2416  }
2417  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2418  if (w_v!=NULL)
2419  {
2420    w_v=ivCopy(w_v);
2421    hom=isHomog;
2422  }
2423  if ((w_u!=NULL) && (w_v==NULL))
2424    w_v=ivCopy(w_u);
2425  if ((w_v!=NULL) && (w_u==NULL))
2426    w_u=ivCopy(w_v);
2427  ideal u_id=(ideal)u->Data();
2428  ideal v_id=(ideal)v->Data();
2429  if (w_u!=NULL)
2430  {
2431     if ((*w_u).compare((w_v))!=0)
2432     {
2433       WarnS("incompatible weights");
2434       delete w_u; w_u=NULL;
2435       hom=testHomog;
2436     }
2437     else
2438     {
2439       if ((!idTestHomModule(u_id,currQuotient,w_v))
2440       || (!idTestHomModule(v_id,currQuotient,w_v)))
2441       {
2442         WarnS("wrong weights");
2443         delete w_u; w_u=NULL;
2444         hom=testHomog;
2445       }
2446     }
2447  }
2448  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2449  if (w_u!=NULL)
2450  {
2451    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2452  }
2453  delete w_v;
2454  return FALSE;
2455}
2456static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2457{
2458  number q=(number)v->Data();
2459  if (nlIsZero(q))
2460  {
2461    WerrorS(ii_div_by_0);
2462    return TRUE;
2463  }
2464  res->data =(char *) nlIntMod((number)u->Data(),q);
2465  return FALSE;
2466}
2467static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2468{
2469  number q=(number)v->Data();
2470  if (nIsZero(q))
2471  {
2472    WerrorS(ii_div_by_0);
2473    return TRUE;
2474  }
2475  res->data =(char *) nIntMod((number)u->Data(),q);
2476  return FALSE;
2477}
2478static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2479static BOOLEAN jjMONITOR1(leftv res, leftv v)
2480{
2481  return jjMONITOR2(res,v,NULL);
2482}
2483static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v)
2484{
2485#if 0
2486  char *opt=(char *)v->Data();
2487  int mode=0;
2488  while(*opt!='\0')
2489  {
2490    if (*opt=='i') mode |= PROT_I;
2491    else if (*opt=='o') mode |= PROT_O;
2492    opt++;
2493  }
2494  monitor((char *)(u->Data()),mode);
2495#else
2496  si_link l=(si_link)u->Data();
2497  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2498  if(strcmp(l->m->type,"ASCII")!=0)
2499  {
2500    Werror("ASCII link required, not `%s`",l->m->type);
2501    slClose(l);
2502    return TRUE;
2503  }
2504  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2505  if ( l->name[0]!='\0') // "" is the stop condition
2506  {
2507    const char *opt;
2508    int mode=0;
2509    if (v==NULL) opt=(const char*)"i";
2510    else         opt=(const char *)v->Data();
2511    while(*opt!='\0')
2512    {
2513      if (*opt=='i') mode |= PROT_I;
2514      else if (*opt=='o') mode |= PROT_O;
2515      opt++;
2516    }
2517    monitor((FILE *)l->data,mode);
2518  }
2519  else
2520    monitor(NULL,0);
2521  return FALSE;
2522#endif
2523}
2524static BOOLEAN jjMONOM(leftv res, leftv v)
2525{
2526  intvec *iv=(intvec *)v->Data();
2527  poly p=pOne();
2528  int i,e;
2529  BOOLEAN err=FALSE;
2530  for(i=si_min(pVariables,iv->length()); i>0; i--)
2531  {
2532    e=(*iv)[i-1];
2533    if (e>=0) pSetExp(p,i,e);
2534    else err=TRUE;
2535  }
2536  if (iv->length()==(pVariables+1))
2537  {
2538    res->rtyp=VECTOR_CMD;
2539    e=(*iv)[pVariables];
2540    if (e>=0) pSetComp(p,e);
2541    else err=TRUE;
2542  }
2543  pSetm(p);
2544  res->data=(char*)p;
2545  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2546  return err;
2547}
2548static BOOLEAN jjNEWSTRUCT2(leftv res, leftv u, leftv v)
2549{
2550  // u: the name of the new type
2551  // v: the elements
2552  newstruct_desc d=newstructFromString((const char *)v->Data());
2553  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2554  return d==NULL;
2555}
2556static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2557{
2558  idhdl h=(idhdl)u->data;
2559  int i=(int)(long)v->Data();
2560  int p=0;
2561  if ((0<i)
2562  && (IDRING(h)->parameter!=NULL)
2563  && (i<=(p=rPar(IDRING(h)))))
2564    res->data=omStrDup(IDRING(h)->parameter[i-1]);
2565  else
2566  {
2567    Werror("par number %d out of range 1..%d",i,p);
2568    return TRUE;
2569  }
2570  return FALSE;
2571}
2572#ifdef HAVE_PLURAL
2573static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2574{
2575  if( currRing->qideal != NULL )
2576  {
2577    WerrorS("basering must NOT be a qring!");
2578    return TRUE;
2579  }
2580
2581  if (iiOp==NCALGEBRA_CMD)
2582  {
2583    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing);
2584  }
2585  else
2586  {
2587    ring r=rCopy(currRing);
2588    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r);
2589    res->data=r;
2590    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2591    return result;
2592  }
2593}
2594static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2595{
2596  if( currRing->qideal != NULL )
2597  {
2598    WerrorS("basering must NOT be a qring!");
2599    return TRUE;
2600  }
2601
2602  if (iiOp==NCALGEBRA_CMD)
2603  {
2604    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing);
2605  }
2606  else
2607  {
2608    ring r=rCopy(currRing);
2609    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r);
2610    res->data=r;
2611    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2612    return result;
2613  }
2614}
2615static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2616{
2617  if( currRing->qideal != NULL )
2618  {
2619    WerrorS("basering must NOT be a qring!");
2620    return TRUE;
2621  }
2622
2623  if (iiOp==NCALGEBRA_CMD)
2624  {
2625    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing);
2626  }
2627  else
2628  {
2629    ring r=rCopy(currRing);
2630    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r);
2631    res->data=r;
2632    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2633    return result;
2634  }
2635}
2636static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2637{
2638  if( currRing->qideal != NULL )
2639  {
2640    WerrorS("basering must NOT be a qring!");
2641    return TRUE;
2642  }
2643
2644  if (iiOp==NCALGEBRA_CMD)
2645  {
2646    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing);
2647  }
2648  else
2649  {
2650    ring r=rCopy(currRing);
2651    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r);
2652    res->data=r;
2653    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2654    return result;
2655  }
2656}
2657static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2658{
2659  res->data=NULL;
2660
2661  if (rIsPluralRing(currRing))
2662  {
2663    const poly q = (poly)b->Data();
2664
2665    if( q != NULL )
2666    {
2667      if( (poly)a->Data() != NULL )
2668      {
2669        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2670        res->data = nc_p_Bracket_qq(p,q); // p will be destroyed!
2671      }
2672    }
2673  }
2674  return FALSE;
2675}
2676static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2677{
2678  /* number, poly, vector, ideal, module, matrix */
2679  ring  r = (ring)a->Data();
2680  if (r == currRing)
2681  {
2682    res->data = b->Data();
2683    res->rtyp = b->rtyp;
2684    return FALSE;
2685  }
2686  if (!rIsLikeOpposite(currRing, r))
2687  {
2688    Werror("%s is not an opposite ring to current ring",a->Fullname());
2689    return TRUE;
2690  }
2691  idhdl w;
2692  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2693  {
2694    int argtype = IDTYP(w);
2695    switch (argtype)
2696    {
2697    case NUMBER_CMD:
2698      {
2699        /* since basefields are equal, we can apply nCopy */
2700        res->data = nCopy((number)IDDATA(w));
2701        res->rtyp = argtype;
2702        break;
2703      }
2704    case POLY_CMD:
2705    case VECTOR_CMD:
2706      {
2707        poly    q = (poly)IDDATA(w);
2708        res->data = pOppose(r,q);
2709        res->rtyp = argtype;
2710        break;
2711      }
2712    case IDEAL_CMD:
2713    case MODUL_CMD:
2714      {
2715        ideal   Q = (ideal)IDDATA(w);
2716        res->data = idOppose(r,Q);
2717        res->rtyp = argtype;
2718        break;
2719      }
2720    case MATRIX_CMD:
2721      {
2722        ring save = currRing;
2723        rChangeCurrRing(r);
2724        matrix  m = (matrix)IDDATA(w);
2725        ideal   Q = idMatrix2Module(mpCopy(m));
2726        rChangeCurrRing(save);
2727        ideal   S = idOppose(r,Q);
2728        id_Delete(&Q, r);
2729        res->data = idModule2Matrix(S);
2730        res->rtyp = argtype;
2731        break;
2732      }
2733    default:
2734      {
2735        WerrorS("unsupported type in oppose");
2736        return TRUE;
2737      }
2738    }
2739  }
2740  else
2741  {
2742    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2743    return TRUE;
2744  }
2745  return FALSE;
2746}
2747#endif /* HAVE_PLURAL */
2748
2749static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2750{
2751  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2752    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2753  idDelMultiples((ideal)(res->data));
2754  return FALSE;
2755}
2756static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2757{
2758  int i=(int)(long)u->Data();
2759  int j=(int)(long)v->Data();
2760  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2761  return FALSE;
2762}
2763static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2764{
2765  matrix m =(matrix)u->Data();
2766  int isRowEchelon = (int)(long)v->Data();
2767  if (isRowEchelon != 1) isRowEchelon = 0;
2768  int rank = luRank(m, isRowEchelon);
2769  res->data =(char *)(long)rank;
2770  return FALSE;
2771}
2772static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2773{
2774  si_link l=(si_link)u->Data();
2775  leftv r=slRead(l,v);
2776  if (r==NULL)
2777  {
2778    const char *s;
2779    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2780    else                            s=sNoName;
2781    Werror("cannot read from `%s`",s);
2782    return TRUE;
2783  }
2784  memcpy(res,r,sizeof(sleftv));
2785  omFreeBin((ADDRESS)r, sleftv_bin);
2786  return FALSE;
2787}
2788static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2789{
2790  assumeStdFlag(v);
2791  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2792  return FALSE;
2793}
2794static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2795{
2796  assumeStdFlag(v);
2797  ideal ui=(ideal)u->Data();
2798  idTest(ui);
2799  ideal vi=(ideal)v->Data();
2800  idTest(vi);
2801  res->data = (char *)kNF(vi,currQuotient,ui);
2802  return FALSE;
2803}
2804#if 0
2805static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2806{
2807  int maxl=(int)(long)v->Data();
2808  if (maxl<0)
2809  {
2810    WerrorS("length for res must not be negative");
2811    return TRUE;
2812  }
2813  int l=0;
2814  //resolvente r;
2815  syStrategy r;
2816  intvec *weights=NULL;
2817  int wmaxl=maxl;
2818  ideal u_id=(ideal)u->Data();
2819
2820  maxl--;
2821  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2822  {
2823    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2824    if (currQuotient!=NULL)
2825    {
2826      Warn(
2827      "full resolution in a qring may be infinite, setting max length to %d",
2828      maxl+1);
2829    }
2830  }
2831  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2832  if (weights!=NULL)
2833  {
2834    if (!idTestHomModule(u_id,currQuotient,weights))
2835    {
2836      WarnS("wrong weights given:");weights->show();PrintLn();
2837      weights=NULL;
2838    }
2839  }
2840  intvec *ww=NULL;
2841  int add_row_shift=0;
2842  if (weights!=NULL)
2843  {
2844     ww=ivCopy(weights);
2845     add_row_shift = ww->min_in();
2846     (*ww) -= add_row_shift;
2847  }
2848  else
2849    idHomModule(u_id,currQuotient,&ww);
2850  weights=ww;
2851
2852  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2853  {
2854    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2855  }
2856  else if (iiOp==SRES_CMD)
2857  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2858    r=sySchreyer(u_id,maxl+1);
2859  else if (iiOp == LRES_CMD)
2860  {
2861    int dummy;
2862    if((currQuotient!=NULL)||
2863    (!idHomIdeal (u_id,NULL)))
2864    {
2865       WerrorS
2866       ("`lres` not implemented for inhomogeneous input or qring");
2867       return TRUE;
2868    }
2869    r=syLaScala3(u_id,&dummy);
2870  }
2871  else if (iiOp == KRES_CMD)
2872  {
2873    int dummy;
2874    if((currQuotient!=NULL)||
2875    (!idHomIdeal (u_id,NULL)))
2876    {
2877       WerrorS
2878       ("`kres` not implemented for inhomogeneous input or qring");
2879       return TRUE;
2880    }
2881    r=syKosz(u_id,&dummy);
2882  }
2883  else
2884  {
2885    int dummy;
2886    if((currQuotient!=NULL)||
2887    (!idHomIdeal (u_id,NULL)))
2888    {
2889       WerrorS
2890       ("`hres` not implemented for inhomogeneous input or qring");
2891       return TRUE;
2892    }
2893    r=syHilb(u_id,&dummy);
2894  }
2895  if (r==NULL) return TRUE;
2896  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2897  r->list_length=wmaxl;
2898  res->data=(void *)r;
2899  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2900  {
2901    intvec *w=ivCopy(r->weights[0]);
2902    if (weights!=NULL) (*w) += add_row_shift;
2903    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
2904    w=NULL;
2905  }
2906  else
2907  {
2908//#if 0
2909// need to set weights for ALL components (sres)
2910    if (weights!=NULL)
2911    {
2912      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2913      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
2914      (r->weights)[0] = ivCopy(weights);
2915    }
2916//#endif
2917  }
2918  if (ww!=NULL) { delete ww; ww=NULL; }
2919  return FALSE;
2920}
2921#else
2922static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2923{
2924  int maxl=(int)(long)v->Data();
2925  if (maxl<0)
2926  {
2927    WerrorS("length for res must not be negative");
2928    return TRUE;
2929  }
2930  int l=0;
2931  //resolvente r;
2932  syStrategy r;
2933  intvec *weights=NULL;
2934  int wmaxl=maxl;
2935  ideal u_id=(ideal)u->Data();
2936
2937  maxl--;
2938  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2939  {
2940    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2941    if (currQuotient!=NULL)
2942    {
2943      Warn(
2944      "full resolution in a qring may be infinite, setting max length to %d",
2945      maxl+1);
2946    }
2947  }
2948  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2949  if (weights!=NULL)
2950  {
2951    if (!idTestHomModule(u_id,currQuotient,weights))
2952    {
2953      WarnS("wrong weights given:");weights->show();PrintLn();
2954      weights=NULL;
2955    }
2956  }
2957  intvec *ww=NULL;
2958  int add_row_shift=0;
2959  if (weights!=NULL)
2960  {
2961     ww=ivCopy(weights);
2962     add_row_shift = ww->min_in();
2963     (*ww) -= add_row_shift;
2964  }
2965  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2966  {
2967    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2968  }
2969  else if (iiOp==SRES_CMD)
2970  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2971    r=sySchreyer(u_id,maxl+1);
2972  else if (iiOp == LRES_CMD)
2973  {
2974    int dummy;
2975    if((currQuotient!=NULL)||
2976    (!idHomIdeal (u_id,NULL)))
2977    {
2978       WerrorS
2979       ("`lres` not implemented for inhomogeneous input or qring");
2980       return TRUE;
2981    }
2982    if(currRing->N == 1)
2983      WarnS("the current implementation of `lres` may not work in the case of a single variable");
2984    r=syLaScala3(u_id,&dummy);
2985  }
2986  else if (iiOp == KRES_CMD)
2987  {
2988    int dummy;
2989    if((currQuotient!=NULL)||
2990    (!idHomIdeal (u_id,NULL)))
2991    {
2992       WerrorS
2993       ("`kres` not implemented for inhomogeneous input or qring");
2994       return TRUE;
2995    }
2996    r=syKosz(u_id,&dummy);
2997  }
2998  else
2999  {
3000    int dummy;
3001    if((currQuotient!=NULL)||
3002    (!idHomIdeal (u_id,NULL)))
3003    {
3004       WerrorS
3005       ("`hres` not implemented for inhomogeneous input or qring");
3006       return TRUE;
3007    }
3008    ideal u_id_copy=idCopy(u_id);
3009    idSkipZeroes(u_id_copy);
3010    r=syHilb(u_id_copy,&dummy);
3011    idDelete(&u_id_copy);
3012  }
3013  if (r==NULL) return TRUE;
3014  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3015  r->list_length=wmaxl;
3016  res->data=(void *)r;
3017  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3018  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3019  {
3020    ww=ivCopy(r->weights[0]);
3021    if (weights!=NULL) (*ww) += add_row_shift;
3022    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3023  }
3024  else
3025  {
3026    if (weights!=NULL)
3027    {
3028      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3029    }
3030  }
3031
3032  // test the La Scala case' output
3033  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3034  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3035
3036  if(iiOp != HRES_CMD)
3037    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3038  else
3039    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3040
3041  return FALSE;
3042}
3043#endif
3044static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3045{
3046  number n1; number n2; number temp; int i;
3047
3048  if ((u->Typ() == BIGINT_CMD) ||
3049     ((u->Typ() == NUMBER_CMD) && rField_is_Q()))
3050  {
3051    temp = (number)u->Data();
3052    n1 = nlCopy(temp);
3053  }
3054  else if (u->Typ() == INT_CMD)
3055  {
3056    i = (int)(long)u->Data();
3057    n1 = nlInit(i, NULL);
3058  }
3059  else
3060  {
3061    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3062    return TRUE;
3063  }
3064
3065  if ((v->Typ() == BIGINT_CMD) ||
3066     ((v->Typ() == NUMBER_CMD) && rField_is_Q()))
3067  {
3068    temp = (number)v->Data();
3069    n2 = nlCopy(temp);
3070  }
3071  else if (v->Typ() == INT_CMD)
3072  {
3073    i = (int)(long)v->Data();
3074    n2 = nlInit(i, NULL);
3075  }
3076  else
3077  {
3078    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3079    return TRUE;
3080  }
3081
3082  lists l = primeFactorisation(n1, n2);
3083  nlDelete(&n1, NULL); nlDelete(&n2, NULL);
3084  res->data = (char*)l;
3085  return FALSE;
3086}
3087static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3088{
3089  ring r;
3090  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3091  res->data = (char *)r;
3092  return (i==-1);
3093}
3094#define SIMPL_LMDIV 32
3095#define SIMPL_LMEQ  16
3096#define SIMPL_MULT 8
3097#define SIMPL_EQU  4
3098#define SIMPL_NULL 2
3099#define SIMPL_NORM 1
3100static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3101{
3102  int sw = (int)(long)v->Data();
3103  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3104  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3105  if (sw & SIMPL_LMDIV)
3106  {
3107    idDelDiv(id);
3108  }
3109  if (sw & SIMPL_LMEQ)
3110  {
3111    idDelLmEquals(id);
3112  }
3113  if (sw & SIMPL_MULT)
3114  {
3115    idDelMultiples(id);
3116  }
3117  else if(sw & SIMPL_EQU)
3118  {
3119    idDelEquals(id);
3120  }
3121  if (sw & SIMPL_NULL)
3122  {
3123    idSkipZeroes(id);
3124  }
3125  if (sw & SIMPL_NORM)
3126  {
3127    idNorm(id);
3128  }
3129  res->data = (char * )id;
3130  return FALSE;
3131}
3132static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3133{
3134  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3135  return FALSE;
3136}
3137static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3138{
3139  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3140  //return (res->data== (void*)(long)-2);
3141  return FALSE;
3142}
3143static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3144{
3145  int sw = (int)(long)v->Data();
3146  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3147  poly p = (poly)u->CopyD(POLY_CMD);
3148  if (sw & SIMPL_NORM)
3149  {
3150    pNorm(p);
3151  }
3152  res->data = (char * )p;
3153  return FALSE;
3154}
3155static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3156{
3157  ideal result;
3158  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3159  tHomog hom=testHomog;
3160  ideal u_id=(ideal)(u->Data());
3161  if (w!=NULL)
3162  {
3163    if (!idTestHomModule(u_id,currQuotient,w))
3164    {
3165      WarnS("wrong weights:");w->show();PrintLn();
3166      w=NULL;
3167    }
3168    else
3169    {
3170      w=ivCopy(w);
3171      hom=isHomog;
3172    }
3173  }
3174  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3175  idSkipZeroes(result);
3176  res->data = (char *)result;
3177  setFlag(res,FLAG_STD);
3178  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3179  return FALSE;
3180}
3181static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3182static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3183/* destroys i0, p0 */
3184/* result (with attributes) in res */
3185/* i0: SB*/
3186/* t0: type of p0*/
3187/* p0 new elements*/
3188/* a attributes of i0*/
3189{
3190  int tp;
3191  if (t0==IDEAL_CMD) tp=POLY_CMD;
3192  else               tp=VECTOR_CMD;
3193  for (int i=IDELEMS(p0)-1; i>=0; i--)
3194  {
3195    poly p=p0->m[i];
3196    p0->m[i]=NULL;
3197    if (p!=NULL)
3198    {
3199      sleftv u0,v0;
3200      memset(&u0,0,sizeof(sleftv));
3201      memset(&v0,0,sizeof(sleftv));
3202      v0.rtyp=tp;
3203      v0.data=(void*)p;
3204      u0.rtyp=t0;
3205      u0.data=i0;
3206      u0.attribute=a;
3207      setFlag(&u0,FLAG_STD);
3208      jjSTD_1(res,&u0,&v0);
3209      i0=(ideal)res->data;
3210      res->data=NULL;
3211      a=res->attribute;
3212      res->attribute=NULL;
3213      u0.CleanUp();
3214      v0.CleanUp();
3215      res->CleanUp();
3216    }
3217  }
3218  idDelete(&p0);
3219  res->attribute=a;
3220  res->data=(void *)i0;
3221  res->rtyp=t0;
3222}
3223static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3224{
3225  ideal result;
3226  assumeStdFlag(u);
3227  ideal i1=(ideal)(u->Data());
3228  ideal i0;
3229  int r=v->Typ();
3230  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3231  {
3232    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3233    i0->m[0]=(poly)v->Data();
3234    int ii0=idElem(i0); /* size of i0 */
3235    i1=idSimpleAdd(i1,i0); //
3236    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3237    idDelete(&i0);
3238    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3239    tHomog hom=testHomog;
3240
3241    if (w!=NULL)
3242    {
3243      if (!idTestHomModule(i1,currQuotient,w))
3244      {
3245        // no warnung: this is legal, if i in std(i,p)
3246        // is homogeneous, but p not
3247        w=NULL;
3248      }
3249      else
3250      {
3251        w=ivCopy(w);
3252        hom=isHomog;
3253      }
3254    }
3255    BITSET save_test=test;
3256    test|=Sy_bit(OPT_SB_1);
3257    /* ii0 appears to be the position of the first element of il that
3258       does not belong to the old SB ideal */
3259    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3260    test=save_test;
3261    idDelete(&i1);
3262    idSkipZeroes(result);
3263    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3264    res->data = (char *)result;
3265  }
3266  else /*IDEAL/MODULE*/
3267  {
3268    attr *aa=u->Attribute();
3269    attr a=NULL;
3270    if (aa!=NULL) a=(*aa)->Copy();
3271    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3272  }
3273  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3274  return FALSE;
3275}
3276static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3277{
3278  idhdl h=(idhdl)u->data;
3279  int i=(int)(long)v->Data();
3280  if ((0<i) && (i<=IDRING(h)->N))
3281    res->data=omStrDup(IDRING(h)->names[i-1]);
3282  else
3283  {
3284    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3285    return TRUE;
3286  }
3287  return FALSE;
3288}
3289static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3290{
3291// input: u: a list with links of type
3292//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3293//        v: timeout for select in milliseconds
3294//           or 0 for polling
3295// returns: ERROR (via Werror): timeout negative
3296//           -1: the read state of all links is eof
3297//            0: timeout (or polling): none ready
3298//           i>0: (at least) L[i] is ready
3299  lists Lforks = (lists)u->Data();
3300  int t = (int)(long)v->Data();
3301  if(t < 0)
3302  {
3303    WerrorS("negative timeout"); return TRUE;
3304  }
3305  int i = slStatusSsiL(Lforks, t*1000);
3306  if(i == -2) /* error */
3307  {
3308    return TRUE;
3309  }
3310  res->data = (void*)(long)i;
3311  return FALSE;
3312}
3313static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3314{
3315// input: u: a list with links of type
3316//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3317//        v: timeout for select in milliseconds
3318//           or 0 for polling
3319// returns: ERROR (via Werror): timeout negative
3320//           -1: the read state of all links is eof
3321//           0: timeout (or polling): none ready
3322//           1: all links are ready
3323//              (caution: at least one is ready, but some maybe dead)
3324  lists Lforks = (lists)u->CopyD();
3325  int timeout = 1000*(int)(long)v->Data();
3326  if(timeout < 0)
3327  {
3328    WerrorS("negative timeout"); return TRUE;
3329  }
3330  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3331  int i;
3332  int ret = -1;
3333  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3334  {
3335    i = slStatusSsiL(Lforks, timeout);
3336    if(i > 0) /* Lforks[i] is ready */
3337    {
3338      ret = 1;
3339      Lforks->m[i-1].CleanUp();
3340      Lforks->m[i-1].rtyp=DEF_CMD;
3341      Lforks->m[i-1].data=NULL;
3342      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3343    }
3344    else /* terminate the for loop */
3345    {
3346      if(i == -2) /* error */
3347      {
3348        return TRUE;
3349      }
3350      if(i == 0) /* timeout */
3351      {
3352        ret = 0;
3353      }
3354      break;
3355    }
3356  }
3357  Lforks->Clean();
3358  res->data = (void*)(long)ret;
3359  return FALSE;
3360}
3361static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3362{
3363  res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
3364  return FALSE;
3365}
3366#define jjWRONG2 (proc2)jjWRONG
3367#define jjWRONG3 (proc3)jjWRONG
3368static BOOLEAN jjWRONG(leftv res, leftv u)
3369{
3370  return TRUE;
3371}
3372
3373/*=================== operations with 1 arg.: static proc =================*/
3374/* must be ordered: first operations for chars (infix ops),
3375 * then alphabetically */
3376
3377static BOOLEAN jjDUMMY(leftv res, leftv u)
3378{
3379  res->data = (char *)u->CopyD();
3380  return FALSE;
3381}
3382static BOOLEAN jjNULL(leftv res, leftv u)
3383{
3384  return FALSE;
3385}
3386//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3387//{
3388//  res->data = (char *)((int)(long)u->Data()+1);
3389//  return FALSE;
3390//}
3391//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3392//{
3393//  res->data = (char *)((int)(long)u->Data()-1);
3394//  return FALSE;
3395//}
3396static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3397{
3398  if (IDTYP((idhdl)u->data)==INT_CMD)
3399  {
3400    int i=IDINT((idhdl)u->data);
3401    if (iiOp==PLUSPLUS) i++;
3402    else                i--;
3403    IDDATA((idhdl)u->data)=(char *)(long)i;
3404    return FALSE;
3405  }
3406  return TRUE;
3407}
3408static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3409{
3410  number n=(number)u->CopyD(BIGINT_CMD);
3411  n=nlNeg(n);
3412  res->data = (char *)n;
3413  return FALSE;
3414}
3415static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3416{
3417  res->data = (char *)(-(long)u->Data());
3418  return FALSE;
3419}
3420static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3421{
3422  number n=(number)u->CopyD(NUMBER_CMD);
3423  n=nNeg(n);
3424  res->data = (char *)n;
3425  return FALSE;
3426}
3427static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3428{
3429  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3430  return FALSE;
3431}
3432static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3433{
3434  poly m1=pISet(-1);
3435  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
3436  return FALSE;
3437}
3438static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3439{
3440  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3441  (*iv)*=(-1);
3442  res->data = (char *)iv;
3443  return FALSE;
3444}
3445static BOOLEAN jjPROC1(leftv res, leftv u)
3446{
3447  return jjPROC(res,u,NULL);
3448}
3449static BOOLEAN jjBAREISS(leftv res, leftv v)
3450{
3451  //matrix m=(matrix)v->Data();
3452  //lists l=mpBareiss(m,FALSE);
3453  intvec *iv;
3454  ideal m;
3455  smCallBareiss((ideal)v->Data(),0,0,m,&iv);
3456  lists l=(lists)omAllocBin(slists_bin);
3457  l->Init(2);
3458  l->m[0].rtyp=MODUL_CMD;
3459  l->m[1].rtyp=INTVEC_CMD;
3460  l->m[0].data=(void *)m;
3461  l->m[1].data=(void *)iv;
3462  res->data = (char *)l;
3463  return FALSE;
3464}
3465//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3466//{
3467//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3468//  ivTriangMat(m);
3469//  res->data = (char *)m;
3470//  return FALSE;
3471//}
3472static BOOLEAN jjBI2N(leftv res, leftv u)
3473{
3474  if (rField_is_Q())
3475  {
3476    res->data=u->CopyD();
3477    return FALSE;
3478  }
3479  else
3480  {
3481    BOOLEAN bo=FALSE;
3482    number n=(number)u->CopyD();
3483    if (rField_is_Zp())
3484    {
3485      res->data=(void *)npMap0(n);
3486    }
3487    else if (rField_is_Q_a())
3488    {
3489      res->data=(void *)naMap00(n);
3490    }
3491    else if (rField_is_Zp_a())
3492    {
3493      res->data=(void *)naMap0P(n);
3494    }
3495#ifdef HAVE_RINGS
3496    else if (rField_is_Ring_Z())
3497    {
3498      res->data=(void *)nrzMapQ(n);
3499    }
3500    else if (rField_is_Ring_ModN())
3501    {
3502      res->data=(void *)nrnMapQ(n);
3503    }
3504    else if (rField_is_Ring_PtoM())
3505    {
3506      res->data=(void *)nrnMapQ(n);
3507    }
3508    else if (rField_is_Ring_2toM())
3509    {
3510      res->data=(void *)nr2mMapQ(n);
3511    }
3512#endif
3513    else
3514    {
3515      WerrorS("cannot convert bigint to this field");
3516      bo=TRUE;
3517    }
3518    nlDelete(&n,NULL);
3519    return bo;
3520  }
3521}
3522static BOOLEAN jjBI2P(leftv res, leftv u)
3523{
3524  sleftv tmp;
3525  BOOLEAN bo=jjBI2N(&tmp,u);
3526  if (!bo)
3527  {
3528    number n=(number) tmp.data;
3529    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3530    else
3531    {
3532      res->data=(void *)pNSet(n);
3533    }
3534  }
3535  return bo;
3536}
3537static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3538{
3539  return iiExprArithM(res,u,iiOp);
3540}
3541static BOOLEAN jjCHAR(leftv res, leftv v)
3542{
3543  res->data = (char *)(long)rChar((ring)v->Data());
3544  return FALSE;
3545}
3546static BOOLEAN jjCOLS(leftv res, leftv v)
3547{
3548  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3549  return FALSE;
3550}
3551static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3552{
3553  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3554  return FALSE;
3555}
3556static BOOLEAN jjCONTENT(leftv res, leftv v)
3557{
3558  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3559  poly p=(poly)v->CopyD(POLY_CMD);
3560  if (p!=NULL) p_Cleardenom(p, currRing);
3561  res->data = (char *)p;
3562  return FALSE;
3563}
3564static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3565{
3566  res->data = (char *)(long)nlSize((number)v->Data());
3567  return FALSE;
3568}
3569static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3570{
3571  res->data = (char *)(long)nSize((number)v->Data());
3572  return FALSE;
3573}
3574static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3575{
3576  lists l=(lists)v->Data();
3577  res->data = (char *)(long)(l->nr+1);
3578  return FALSE;
3579}
3580static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3581{
3582  matrix m=(matrix)v->Data();
3583  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3584  return FALSE;
3585}
3586static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3587{
3588  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3589  return FALSE;
3590}
3591static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3592{
3593  ring r=(ring)v->Data();
3594  int elems=-1;
3595  if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
3596  else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
3597  {
3598#ifdef HAVE_FACTORY
3599    extern int ipower ( int b, int n ); /* factory/cf_util */
3600    elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
3601#else
3602    elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
3603#endif
3604  }
3605  res->data = (char *)(long)elems;
3606  return FALSE;
3607}
3608static BOOLEAN jjDEG(leftv res, leftv v)
3609{
3610  int dummy;
3611  poly p=(poly)v->Data();
3612  if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
3613  else res->data=(char *)-1;
3614  return FALSE;
3615}
3616static BOOLEAN jjDEG_M(leftv res, leftv u)
3617{
3618  ideal I=(ideal)u->Data();
3619  int d=-1;
3620  int dummy;
3621  int i;
3622  for(i=IDELEMS(I)-1;i>=0;i--)
3623    if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
3624  res->data = (char *)(long)d;
3625  return FALSE;
3626}
3627static BOOLEAN jjDEGREE(leftv res, leftv v)
3628{
3629  SPrintStart();
3630#ifdef HAVE_RINGS
3631  if (rField_is_Ring_Z(currRing))
3632  {
3633    ring origR = currRing;
3634    ring tempR = rCopy(origR);
3635    tempR->ringtype = 0; tempR->ch = 0;
3636    rComplete(tempR);
3637    ideal vid = (ideal)v->Data();
3638    rChangeCurrRing(tempR);
3639    ideal vv = idrCopyR(vid, origR, currRing);
3640    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3641    vvAsLeftv.rtyp = IDEAL_CMD;
3642    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3643    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3644    assumeStdFlag(&vvAsLeftv);
3645    Print("// NOTE: computation of degree is being performed for\n");
3646    Print("//       generic fibre, that is, over Q\n");
3647    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3648    scDegree(vv,module_w,currQuotient);
3649    idDelete(&vv);
3650    rChangeCurrRing(origR);
3651    rDelete(tempR);
3652  }
3653#endif
3654  assumeStdFlag(v);
3655  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3656  scDegree((ideal)v->Data(),module_w,currQuotient);
3657  char *s=SPrintEnd();
3658  int l=strlen(s)-1;
3659  s[l]='\0';
3660  res->data=(void*)s;
3661  return FALSE;
3662}
3663static BOOLEAN jjDEFINED(leftv res, leftv v)
3664{
3665  if ((v->rtyp==IDHDL)
3666  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3667  {
3668    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3669  }
3670  else if (v->rtyp!=0) res->data=(void *)(-1);
3671  return FALSE;
3672}
3673#ifdef HAVE_FACTORY
3674static BOOLEAN jjDET(leftv res, leftv v)
3675{
3676  matrix m=(matrix)v->Data();
3677  poly p;
3678  if (smCheckDet((ideal)m,m->cols(),TRUE))
3679  {
3680    ideal I=idMatrix2Module(mpCopy(m));
3681    p=smCallDet(I);
3682    idDelete(&I);
3683  }
3684  else
3685    p=singclap_det(m);
3686  res ->data = (char *)p;
3687  return FALSE;
3688}
3689static BOOLEAN jjDET_I(leftv res, leftv v)
3690{
3691  intvec * m=(intvec*)v->Data();
3692  int i,j;
3693  i=m->rows();j=m->cols();
3694  if(i==j)
3695    res->data = (char *)(long)singclap_det_i(m);
3696  else
3697  {
3698    Werror("det of %d x %d intmat",i,j);
3699    return TRUE;
3700  }
3701  return FALSE;
3702}
3703static BOOLEAN jjDET_S(leftv res, leftv v)
3704{
3705  ideal I=(ideal)v->Data();
3706  poly p;
3707  if (IDELEMS(I)<1) return TRUE;
3708  if (smCheckDet(I,IDELEMS(I),FALSE))
3709  {
3710    matrix m=idModule2Matrix(idCopy(I));
3711    p=singclap_det(m);
3712    idDelete((ideal *)&m);
3713  }
3714  else
3715    p=smCallDet(I);
3716  res->data = (char *)p;
3717  return FALSE;
3718}
3719#endif
3720static BOOLEAN jjDIM(leftv res, leftv v)
3721{
3722  assumeStdFlag(v);
3723#ifdef HAVE_RINGS
3724  if (rField_is_Ring(currRing))
3725  {
3726    ring origR = currRing;
3727    ring tempR = rCopy(origR);
3728    tempR->ringtype = 0; tempR->ch = 0;
3729    rComplete(tempR);
3730    ideal vid = (ideal)v->Data();
3731    int i = idPosConstant(vid);
3732    if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
3733    { /* ideal v contains unit; dim = -1 */
3734      res->data = (char *)-1;
3735      return FALSE;
3736    }
3737    rChangeCurrRing(tempR);
3738    ideal vv = idrCopyR(vid, origR, currRing);
3739    /* drop degree zero generator from vv (if any) */
3740    if (i != -1) pDelete(&vv->m[i]);
3741    long d = (long)scDimInt(vv, currQuotient);
3742    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
3743    res->data = (char *)d;
3744    idDelete(&vv);
3745    rChangeCurrRing(origR);
3746    rDelete(tempR);
3747    return FALSE;
3748  }
3749#endif
3750  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3751  return FALSE;
3752}
3753static BOOLEAN jjDUMP(leftv res, leftv v)
3754{
3755  si_link l = (si_link)v->Data();
3756  if (slDump(l))
3757  {
3758    const char *s;
3759    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3760    else                            s=sNoName;
3761    Werror("cannot dump to `%s`",s);
3762    return TRUE;
3763  }
3764  else
3765    return FALSE;
3766}
3767static BOOLEAN jjE(leftv res, leftv v)
3768{
3769  res->data = (char *)pOne();
3770  int co=(int)(long)v->Data();
3771  if (co>0)
3772  {
3773    pSetComp((poly)res->data,co);
3774    pSetm((poly)res->data);
3775  }
3776  else WerrorS("argument of gen must be positive");
3777  return (co<=0);
3778}
3779static BOOLEAN jjEXECUTE(leftv res, leftv v)
3780{
3781  char * d = (char *)v->Data();
3782  char * s = (char *)omAlloc(strlen(d) + 13);
3783  strcpy( s, (char *)d);
3784  strcat( s, "\n;RETURN();\n");
3785  newBuffer(s,BT_execute);
3786  return yyparse();
3787}
3788#ifdef HAVE_FACTORY
3789static BOOLEAN jjFACSTD(leftv res, leftv v)
3790{
3791  lists L=(lists)omAllocBin(slists_bin);
3792  if (rField_is_Zp()
3793  || rField_is_Q()
3794  || rField_is_Zp_a()
3795  || rField_is_Q_a())
3796  {
3797    ideal_list p,h;
3798    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3799    if (h==NULL)
3800    {
3801      L->Init(1);
3802      L->m[0].data=(char *)idInit(0,1);
3803      L->m[0].rtyp=IDEAL_CMD;
3804    }
3805    else
3806    {
3807      p=h;
3808      int l=0;
3809      while (p!=NULL) { p=p->next;l++; }
3810      L->Init(l);
3811      l=0;
3812      while(h!=NULL)
3813      {
3814        L->m[l].data=(char *)h->d;
3815        L->m[l].rtyp=IDEAL_CMD;
3816        p=h->next;
3817        omFreeSize(h,sizeof(*h));
3818        h=p;
3819        l++;
3820      }
3821    }
3822  }
3823  else
3824  {
3825    WarnS("no factorization implemented");
3826    L->Init(1);
3827    iiExprArith1(&(L->m[0]),v,STD_CMD);
3828  }
3829  res->data=(void *)L;
3830  return FALSE;
3831}
3832static BOOLEAN jjFAC_P(leftv res, leftv u)
3833{
3834  intvec *v=NULL;
3835  singclap_factorize_retry=0;
3836  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
3837  if (f==NULL) return TRUE;
3838  ivTest(v);
3839  lists l=(lists)omAllocBin(slists_bin);
3840  l->Init(2);
3841  l->m[0].rtyp=IDEAL_CMD;
3842  l->m[0].data=(void *)f;
3843  l->m[1].rtyp=INTVEC_CMD;
3844  l->m[1].data=(void *)v;
3845  res->data=(void *)l;
3846  return FALSE;
3847}
3848#endif
3849static BOOLEAN jjGETDUMP(leftv res, leftv v)
3850{
3851  si_link l = (si_link)v->Data();
3852  if (slGetDump(l))
3853  {
3854    const char *s;
3855    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3856    else                            s=sNoName;
3857    Werror("cannot get dump from `%s`",s);
3858    return TRUE;
3859  }
3860  else
3861    return FALSE;
3862}
3863static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
3864{
3865  assumeStdFlag(v);
3866  ideal I=(ideal)v->Data();
3867  res->data=(void *)iiHighCorner(I,0);
3868  return FALSE;
3869}
3870static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
3871{
3872  assumeStdFlag(v);
3873  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3874  BOOLEAN delete_w=FALSE;
3875  ideal I=(ideal)v->Data();
3876  int i;
3877  poly p=NULL,po=NULL;
3878  int rk=idRankFreeModule(I);
3879  if (w==NULL)
3880  {
3881    w = new intvec(rk);
3882    delete_w=TRUE;
3883  }
3884  for(i=rk;i>0;i--)
3885  {
3886    p=iiHighCorner(I,i);
3887    if (p==NULL)
3888    {
3889      WerrorS("module must be zero-dimensional");
3890      if (delete_w) delete w;
3891      return TRUE;
3892    }
3893    if (po==NULL)
3894    {
3895      po=p;
3896    }
3897    else
3898    {
3899      // now po!=NULL, p!=NULL
3900      int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
3901      if (d==0)
3902        d=pLmCmp(po,p);
3903      if (d > 0)
3904      {
3905        pDelete(&p);
3906      }
3907      else // (d < 0)
3908      {
3909        pDelete(&po); po=p;
3910      }
3911    }
3912  }
3913  if (delete_w) delete w;
3914  res->data=(void *)po;
3915  return FALSE;
3916}
3917static BOOLEAN jjHILBERT(leftv res, leftv v)
3918{
3919#ifdef HAVE_RINGS
3920  if (rField_is_Ring_Z(currRing))
3921  {
3922    ring origR = currRing;
3923    ring tempR = rCopy(origR);
3924    tempR->ringtype = 0; tempR->ch = 0;
3925    rComplete(tempR);
3926    ideal vid = (ideal)v->Data();
3927    rChangeCurrRing(tempR);
3928    ideal vv = idrCopyR(vid, origR, currRing);
3929    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3930    vvAsLeftv.rtyp = IDEAL_CMD;
3931    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3932    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3933    assumeStdFlag(&vvAsLeftv);
3934    Print("// NOTE: computation of Hilbert series etc. is being\n");
3935    Print("//       performed for generic fibre, that is, over Q\n");
3936    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3937    //scHilbertPoly(vv,currQuotient);
3938    hLookSeries(vv,module_w,currQuotient);
3939    idDelete(&vv);
3940    rChangeCurrRing(origR);
3941    rDelete(tempR);
3942    return FALSE;
3943  }
3944#endif
3945  assumeStdFlag(v);
3946  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3947  //scHilbertPoly((ideal)v->Data(),currQuotient);
3948  hLookSeries((ideal)v->Data(),module_w,currQuotient);
3949  return FALSE;
3950}
3951static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
3952{
3953#ifdef HAVE_RINGS
3954  if (rField_is_Ring_Z(currRing))
3955  {
3956    Print("// NOTE: computation of Hilbert series etc. is being\n");
3957    Print("//       performed for generic fibre, that is, over Q\n");
3958  }
3959#endif
3960  res->data=(void *)hSecondSeries((intvec *)v->Data());
3961  return FALSE;
3962}
3963static BOOLEAN jjHOMOG1(leftv res, leftv v)
3964{
3965  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3966  ideal v_id=(ideal)v->Data();
3967  if (w==NULL)
3968  {
3969    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
3970    if (res->data!=NULL)
3971    {
3972      if (v->rtyp==IDHDL)
3973      {
3974        char *s_isHomog=omStrDup("isHomog");
3975        if (v->e==NULL)
3976          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
3977        else
3978          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
3979      }
3980      else if (w!=NULL) delete w;
3981    } // if res->data==NULL then w==NULL
3982  }
3983  else
3984  {
3985    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
3986    if((res->data==NULL) && (v->rtyp==IDHDL))
3987    {
3988      if (v->e==NULL)
3989        atKill((idhdl)(v->data),"isHomog");
3990      else
3991        atKill((idhdl)(v->LData()),"isHomog");
3992    }
3993  }
3994  return FALSE;
3995}
3996static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
3997{
3998  res->data = (char *)idMaxIdeal((int)(long)v->Data());
3999  setFlag(res,FLAG_STD);
4000  return FALSE;
4001}
4002static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4003{
4004  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4005  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4006  if (IDELEMS((ideal)mat)==0)
4007  {
4008    idDelete((ideal *)&mat);
4009    mat=(matrix)idInit(1,1);
4010  }
4011  else
4012  {
4013    MATROWS(mat)=1;
4014    mat->rank=1;
4015    idTest((ideal)mat);
4016  }
4017  res->data=(char *)mat;
4018  return FALSE;
4019}
4020static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4021{
4022  map m=(map)v->CopyD(MAP_CMD);
4023  omFree((ADDRESS)m->preimage);
4024  m->preimage=NULL;
4025  ideal I=(ideal)m;
4026  I->rank=1;
4027  res->data=(char *)I;
4028  return FALSE;
4029}
4030static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4031{
4032  if (currRing!=NULL)
4033  {
4034    ring q=(ring)v->Data();
4035    if (rSamePolyRep(currRing, q))
4036    {
4037      if (q->qideal==NULL)
4038        res->data=(char *)idInit(1,1);
4039      else
4040        res->data=(char *)idCopy(q->qideal);
4041      return FALSE;
4042    }
4043  }
4044  WerrorS("can only get ideal from identical qring");
4045  return TRUE;
4046}
4047static BOOLEAN jjIm2Iv(leftv res, leftv v)
4048{
4049  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4050  iv->makeVector();
4051  res->data = iv;
4052  return FALSE;
4053}
4054static BOOLEAN jjIMPART(leftv res, leftv v)
4055{
4056  res->data = (char *)nImPart((number)v->Data());
4057  return FALSE;
4058}
4059static BOOLEAN jjINDEPSET(leftv res, leftv v)
4060{
4061  assumeStdFlag(v);
4062  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4063  return FALSE;
4064}
4065static BOOLEAN jjINTERRED(leftv res, leftv v)
4066{
4067  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4068  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4069  res->data = result;
4070  return FALSE;
4071}
4072static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4073{
4074  res->data = (char *)(long)pVar((poly)v->Data());
4075  return FALSE;
4076}
4077static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4078{
4079  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4080  return FALSE;
4081}
4082static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
4083{
4084  res->data = (char *)0;
4085  return FALSE;
4086}
4087static BOOLEAN jjJACOB_P(leftv res, leftv v)
4088{
4089  ideal i=idInit(pVariables,1);
4090  int k;
4091  poly p=(poly)(v->Data());
4092  for (k=pVariables;k>0;k--)
4093  {
4094    i->m[k-1]=pDiff(p,k);
4095  }
4096  res->data = (char *)i;
4097  return FALSE;
4098}
4099/*2
4100 * compute Jacobi matrix of a module/matrix
4101 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables))  ),
4102 * where Mt := transpose(M)
4103 * Note that this is consistent with the current conventions for jacob in Singular,
4104 * whereas M2 computes its transposed.
4105 */
4106static BOOLEAN jjJACOB_M(leftv res, leftv a)
4107{
4108  ideal id = (ideal)a->Data();
4109  id = idTransp(id);
4110  int W = IDELEMS(id);
4111
4112  ideal result = idInit(W * pVariables, id->rank);
4113  poly *p = result->m;
4114
4115  for( int v = 1; v <= pVariables; v++ )
4116  {
4117    poly* q = id->m;
4118    for( int i = 0; i < W; i++, p++, q++ )
4119      *p = pDiff( *q, v );
4120  }
4121  idDelete(&id);
4122
4123  res->data = (char *)result;
4124  return FALSE;
4125}
4126
4127
4128static BOOLEAN jjKBASE(leftv res, leftv v)
4129{
4130  assumeStdFlag(v);
4131  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4132  return FALSE;
4133}
4134#ifdef MDEBUG
4135static BOOLEAN jjpHead(leftv res, leftv v)
4136{
4137  res->data=(char *)pHead((poly)v->Data());
4138  return FALSE;
4139}
4140#endif
4141static BOOLEAN jjL2R(leftv res, leftv v)
4142{
4143  res->data=(char *)syConvList((lists)v->Data());
4144  if (res->data != NULL)
4145    return FALSE;
4146  else
4147    return TRUE;
4148}
4149static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4150{
4151  poly p=(poly)v->Data();
4152  if (p==NULL)
4153  {
4154    res->data=(char *)nInit(0);
4155  }
4156  else
4157  {
4158    res->data=(char *)nCopy(pGetCoeff(p));
4159  }
4160  return FALSE;
4161}
4162static BOOLEAN jjLEADEXP(leftv res, leftv v)
4163{
4164  poly p=(poly)v->Data();
4165  int s=pVariables;
4166  if (v->Typ()==VECTOR_CMD) s++;
4167  intvec *iv=new intvec(s);
4168  if (p!=NULL)
4169  {
4170    for(int i = pVariables;i;i--)
4171    {
4172      (*iv)[i-1]=pGetExp(p,i);
4173    }
4174    if (s!=pVariables)
4175      (*iv)[pVariables]=pGetComp(p);
4176  }
4177  res->data=(char *)iv;
4178  return FALSE;
4179}
4180static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4181{
4182  poly p=(poly)v->Data();
4183  if (p == NULL)
4184  {
4185    res->data = (char*) NULL;
4186  }
4187  else
4188  {
4189    poly lm = pLmInit(p);
4190    pSetCoeff(lm, nInit(1));
4191    res->data = (char*) lm;
4192  }
4193  return FALSE;
4194}
4195static BOOLEAN jjLOAD1(leftv res, leftv v)
4196{
4197  return jjLOAD(res, v,FALSE);
4198}
4199static BOOLEAN jjLISTRING(leftv res, leftv v)
4200{
4201  ring r=rCompose((lists)v->Data());
4202  if (r==NULL) return TRUE;
4203  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4204  res->data=(char *)r;
4205  return FALSE;
4206}
4207#if SIZEOF_LONG == 8
4208static number jjLONG2N(long d)
4209{
4210  int i=(int)d;
4211  if ((long)i == d)
4212  {
4213    return nlInit(i, NULL);
4214  }
4215  else
4216  {
4217#if !defined(OM_NDEBUG) && !defined(NDEBUG)
4218    omCheckBin(rnumber_bin);
4219#endif
4220    number z=(number)omAllocBin(rnumber_bin);
4221    #if defined(LDEBUG)
4222    z->debug=123456;
4223    #endif
4224    z->s=3;
4225    mpz_init_set_si(z->z,d);
4226    return z;
4227  }
4228}
4229#else
4230#define jjLONG2N(D) nlInit((int)D, NULL)
4231#endif
4232static BOOLEAN jjPFAC1(leftv res, leftv v)
4233{
4234  /* call method jjPFAC2 with second argument = 0 (meaning that no
4235     valid bound for the prime factors has been given) */
4236  sleftv tmp;
4237  memset(&tmp, 0, sizeof(tmp));
4238  tmp.rtyp = INT_CMD;
4239  return jjPFAC2(res, v, &tmp);
4240}
4241static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4242{
4243  /* computes the LU-decomposition of a matrix M;
4244     i.e., M = P * L * U, where
4245        - P is a row permutation matrix,
4246        - L is in lower triangular form,
4247        - U is in upper row echelon form
4248     Then, we also have P * M = L * U.
4249     A list [P, L, U] is returned. */
4250  matrix mat = (const matrix)v->Data();
4251  int rr = mat->rows();
4252  int cc = mat->cols();
4253  matrix pMat;
4254  matrix lMat;
4255  matrix uMat;
4256
4257  luDecomp(mat, pMat, lMat, uMat);
4258
4259  lists ll = (lists)omAllocBin(slists_bin);
4260  ll->Init(3);
4261  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4262  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4263  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4264  res->data=(char*)ll;
4265
4266  return FALSE;
4267}
4268static BOOLEAN jjMEMORY(leftv res, leftv v)
4269{
4270  omUpdateInfo();
4271  long d;
4272  switch(((int)(long)v->Data()))
4273  {
4274  case 0:
4275    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4276    break;
4277  case 1:
4278    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4279    break;
4280  case 2:
4281    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4282    break;
4283  default:
4284    omPrintStats(stdout);
4285    omPrintInfo(stdout);
4286    omPrintBinStats(stdout);
4287    res->data = (char *)0;
4288    res->rtyp = NONE;
4289  }
4290  return FALSE;
4291  res->data = (char *)0;
4292  return FALSE;
4293}
4294//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4295//{
4296//  return jjMONITOR2(res,v,NULL);
4297//}
4298static BOOLEAN jjMSTD(leftv res, leftv v)
4299{
4300  int t=v->Typ();
4301  ideal r,m;
4302  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4303  lists l=(lists)omAllocBin(slists_bin);
4304  l->Init(2);
4305  l->m[0].rtyp=t;
4306  l->m[0].data=(char *)r;
4307  setFlag(&(l->m[0]),FLAG_STD);
4308  l->m[1].rtyp=t;
4309  l->m[1].data=(char *)m;
4310  res->data=(char *)l;
4311  return FALSE;
4312}
4313static BOOLEAN jjMULT(leftv res, leftv v)
4314{
4315  assumeStdFlag(v);
4316  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4317  return FALSE;
4318}
4319static BOOLEAN jjMINRES_R(leftv res, leftv v)
4320{
4321  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4322
4323  syStrategy tmp=(syStrategy)v->Data();
4324  tmp = syMinimize(tmp); // enrich itself!
4325
4326  res->data=(char *)tmp;
4327
4328  if (weights!=NULL)
4329    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4330
4331  return FALSE;
4332}
4333static BOOLEAN jjN2BI(leftv res, leftv v)
4334{
4335  number n,i; i=(number)v->Data();
4336  if (rField_is_Zp())
4337  {
4338    n=nlInit(npInt(i,currRing),NULL);
4339  }
4340  else if (rField_is_Q()) n=nlBigInt(i);
4341#ifdef HAVE_RINGS
4342  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
4343  else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
4344#endif
4345  else goto err;
4346  res->data=(void *)n;
4347  return FALSE;
4348err:
4349  WerrorS("cannot convert to bigint"); return TRUE;
4350}
4351static BOOLEAN jjNAMEOF(leftv res, leftv v)
4352{
4353  res->data = (char *)v->name;
4354  if (res->data==NULL) res->data=omStrDup("");
4355  v->name=NULL;
4356  return FALSE;
4357}
4358static BOOLEAN jjNAMES(leftv res, leftv v)
4359{
4360  res->data=ipNameList(((ring)v->Data())->idroot);
4361  return FALSE;
4362}
4363static BOOLEAN jjNVARS(leftv res, leftv v)
4364{
4365  res->data = (char *)(long)(((ring)(v->Data()))->N);
4366  return FALSE;
4367}
4368static BOOLEAN jjOpenClose(leftv res, leftv v)
4369{
4370  si_link l=(si_link)v->Data();
4371  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4372  else                return slClose(l);
4373}
4374static BOOLEAN jjORD(leftv res, leftv v)
4375{
4376  poly p=(poly)v->Data();
4377  res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
4378  return FALSE;
4379}
4380static BOOLEAN jjPAR1(leftv res, leftv v)
4381{
4382  int i=(int)(long)v->Data();
4383  int p=0;
4384  p=rPar(currRing);
4385  if ((0<i) && (i<=p))
4386  {
4387    res->data=(char *)nPar(i);
4388  }
4389  else
4390  {
4391    Werror("par number %d out of range 1..%d",i,p);
4392    return TRUE;
4393  }
4394  return FALSE;
4395}
4396static BOOLEAN jjPARDEG(leftv res, leftv v)
4397{
4398  res->data = (char *)(long)nParDeg((number)v->Data());
4399  return FALSE;
4400}
4401static BOOLEAN jjPARSTR1(leftv res, leftv v)
4402{
4403  if (currRing==NULL)
4404  {
4405    WerrorS("no ring active");
4406    return TRUE;
4407  }
4408  int i=(int)(long)v->Data();
4409  int p=0;
4410  if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
4411    res->data=omStrDup(currRing->parameter[i-1]);
4412  else
4413  {
4414    Werror("par number %d out of range 1..%d",i,p);
4415    return TRUE;
4416  }
4417  return FALSE;
4418}
4419static BOOLEAN jjP2BI(leftv res, leftv v)
4420{
4421  poly p=(poly)v->Data();
4422  if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
4423  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4424  {
4425    WerrorS("poly must be constant");
4426    return TRUE;
4427  }
4428  number i=pGetCoeff(p);
4429  number n;
4430  if (rField_is_Zp())
4431  {
4432    n=nlInit(npInt(i,currRing), NULL);
4433  }
4434  else if (rField_is_Q()) n=nlBigInt(i);
4435#ifdef HAVE_RINGS
4436  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
4437    n=nlMapGMP(i);
4438  else if (rField_is_Ring_2toM())
4439    n=nlInit((unsigned long) i, NULL);
4440#endif
4441  else goto err;
4442  res->data=(void *)n;
4443  return FALSE;
4444err:
4445  WerrorS("cannot convert to bigint"); return TRUE;
4446}
4447static BOOLEAN jjP2I(leftv res, leftv v)
4448{
4449  poly p=(poly)v->Data();
4450  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4451  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4452  {
4453    WerrorS("poly must be constant");
4454    return TRUE;
4455  }
4456  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
4457  return FALSE;
4458}
4459static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4460{
4461  map mapping=(map)v->Data();
4462  syMake(res,omStrDup(mapping->preimage));
4463  return FALSE;
4464}
4465static BOOLEAN jjPRIME(leftv res, leftv v)
4466{
4467  int i = IsPrime((int)(long)(v->Data()));
4468  res->data = (char *)(long)(i > 1 ? i : 2);
4469  return FALSE;
4470}
4471static BOOLEAN jjPRUNE(leftv res, leftv v)
4472{
4473  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4474  ideal v_id=(ideal)v->Data();
4475  if (w!=NULL)
4476  {
4477    if (!idTestHomModule(v_id,currQuotient,w))
4478    {
4479      WarnS("wrong weights");
4480      w=NULL;
4481      // and continue at the non-homog case below
4482    }
4483    else
4484    {
4485      w=ivCopy(w);
4486      intvec **ww=&w;
4487      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4488      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4489      return FALSE;
4490    }
4491  }
4492  res->data = (char *)idMinEmbedding(v_id);
4493  return FALSE;
4494}
4495static BOOLEAN jjP2N(leftv res, leftv v)
4496{
4497  number n;
4498  poly p;
4499  if (((p=(poly)v->Data())!=NULL)
4500  && (pIsConstant(p)))
4501  {
4502    n=nCopy(pGetCoeff(p));
4503  }
4504  else
4505  {
4506    n=nInit(0);
4507  }
4508  res->data = (char *)n;
4509  return FALSE;
4510}
4511static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4512{
4513  char *s= (char *)v->Data();
4514  int i = 1;
4515  int l = strlen(s);
4516  for(i=0; i<sArithBase.nCmdUsed; i++)
4517  {
4518    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4519    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4520    {
4521      res->data = (char *)1;
4522      return FALSE;
4523    }
4524  }
4525  //res->data = (char *)0;
4526  return FALSE;
4527}
4528static BOOLEAN jjRANK1(leftv res, leftv v)
4529{
4530  matrix m =(matrix)v->Data();
4531  int rank = luRank(m, 0);
4532  res->data =(char *)(long)rank;
4533  return FALSE;
4534}
4535static BOOLEAN jjREAD(leftv res, leftv v)
4536{
4537  return jjREAD2(res,v,NULL);
4538}
4539static BOOLEAN jjREGULARITY(leftv res, leftv v)
4540{
4541  res->data = (char *)(long)iiRegularity((lists)v->Data());
4542  return FALSE;
4543}
4544static BOOLEAN jjREPART(leftv res, leftv v)
4545{
4546  res->data = (char *)nRePart((number)v->Data());
4547  return FALSE;
4548}
4549static BOOLEAN jjRINGLIST(leftv res, leftv v)
4550{
4551  ring r=(ring)v->Data();
4552  if (r!=NULL)
4553    res->data = (char *)rDecompose((ring)v->Data());
4554  return (r==NULL)||(res->data==NULL);
4555}
4556static BOOLEAN jjROWS(leftv res, leftv v)
4557{
4558  ideal i = (ideal)v->Data();
4559  res->data = (char *)i->rank;
4560  return FALSE;
4561}
4562static BOOLEAN jjROWS_IV(leftv res, leftv v)
4563{
4564  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4565  return FALSE;
4566}
4567static BOOLEAN jjRPAR(leftv res, leftv v)
4568{
4569  res->data = (char *)(long)rPar(((ring)v->Data()));
4570  return FALSE;
4571}
4572static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4573{
4574#ifdef HAVE_PLURAL
4575  const bool bIsSCA = rIsSCA(currRing);
4576#else
4577  const bool bIsSCA = false;
4578#endif
4579
4580  if ((currQuotient!=NULL) && !bIsSCA)
4581  {
4582    WerrorS("qring not supported by slimgb at the moment");
4583    return TRUE;
4584  }
4585  if (rHasLocalOrMixedOrdering_currRing())
4586  {
4587    WerrorS("ordering must be global for slimgb");
4588    return TRUE;
4589  }
4590  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4591  tHomog hom=testHomog;
4592  ideal u_id=(ideal)u->Data();
4593  if (w!=NULL)
4594  {
4595    if (!idTestHomModule(u_id,currQuotient,w))
4596    {
4597      WarnS("wrong weights");
4598      w=NULL;
4599    }
4600    else
4601    {
4602      w=ivCopy(w);
4603      hom=isHomog;
4604    }
4605  }
4606
4607  assume(u_id->rank>=idRankFreeModule(u_id));
4608  res->data=(char *)t_rep_gb(currRing,
4609    u_id,u_id->rank);
4610  //res->data=(char *)t_rep_gb(currRing, u_id);
4611
4612  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4613  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4614  return FALSE;
4615}
4616static BOOLEAN jjSTD(leftv res, leftv v)
4617{
4618  ideal result;
4619  ideal v_id=(ideal)v->Data();
4620  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4621  tHomog hom=testHomog;
4622  if (w!=NULL)
4623  {
4624    if (!idTestHomModule(v_id,currQuotient,w))
4625    {
4626      WarnS("wrong weights");
4627      w=NULL;
4628    }
4629    else
4630    {
4631      hom=isHomog;
4632      w=ivCopy(w);
4633    }
4634  }
4635  result=kStd(v_id,currQuotient,hom,&w);
4636  idSkipZeroes(result);
4637  res->data = (char *)result;
4638  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4639  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4640  return FALSE;
4641}
4642static BOOLEAN jjSort_Id(leftv res, leftv v)
4643{
4644  res->data = (char *)idSort((ideal)v->Data());
4645  return FALSE;
4646}
4647#ifdef HAVE_FACTORY
4648extern int singclap_factorize_retry;
4649static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4650{
4651  intvec *v=NULL;
4652  singclap_factorize_retry=0;
4653  ideal f=singclap_sqrfree((poly)(u->CopyD()));
4654  if (f==NULL)
4655    return TRUE;
4656  res->data=(void *)f;
4657  return FALSE;
4658}
4659#endif
4660#if 1
4661static BOOLEAN jjSYZYGY(leftv res, leftv v)
4662{
4663  intvec *w=NULL;
4664  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4665  if (w!=NULL) delete w;
4666  return FALSE;
4667}
4668#else
4669// activate, if idSyz handle module weights correctly !
4670static BOOLEAN jjSYZYGY(leftv res, leftv v)
4671{
4672  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4673  ideal v_id=(ideal)v->Data();
4674  tHomog hom=testHomog;
4675  int add_row_shift=0;
4676  if (w!=NULL)
4677  {
4678    w=ivCopy(w);
4679    add_row_shift=w->min_in();
4680    (*w)-=add_row_shift;
4681    if (idTestHomModule(v_id,currQuotient,w))
4682      hom=isHomog;
4683    else
4684    {
4685      //WarnS("wrong weights");
4686      delete w; w=NULL;
4687      hom=testHomog;
4688    }
4689  }
4690  res->data = (char *)idSyzygies(v_id,hom,&w);
4691  if (w!=NULL)
4692  {
4693    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4694  }
4695  return FALSE;
4696}
4697#endif
4698static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4699{
4700  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4701  return FALSE;
4702}
4703static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4704{
4705  res->data = (char *)ivTranp((intvec*)(v->Data()));
4706  return FALSE;
4707}
4708#ifdef HAVE_PLURAL
4709static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4710{
4711  ring    r = (ring)a->Data();
4712  //if (rIsPluralRing(r))
4713  if (r->OrdSgn==1)
4714  {
4715    res->data = rOpposite(r);
4716  }
4717  else
4718  {
4719    WarnS("opposite only for global orderings");
4720    res->data = rCopy(r);
4721  }
4722  return FALSE;
4723}
4724static BOOLEAN jjENVELOPE(leftv res, leftv a)
4725{
4726  ring    r = (ring)a->Data();
4727  if (rIsPluralRing(r))
4728  {
4729    //    ideal   i;
4730//     if (a->rtyp == QRING_CMD)
4731//     {
4732//       i = r->qideal;
4733//       r->qideal = NULL;
4734//     }
4735    ring s = rEnvelope(r);
4736//     if (a->rtyp == QRING_CMD)
4737//     {
4738//       ideal is  = idOppose(r,i); /* twostd? */
4739//       is        = idAdd(is,i);
4740//       s->qideal = i;
4741//     }
4742    res->data = s;
4743  }
4744  else  res->data = rCopy(r);
4745  return FALSE;
4746}
4747static BOOLEAN jjTWOSTD(leftv res, leftv a)
4748{
4749  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4750  else  res->data=(ideal)a->CopyD();
4751  setFlag(res,FLAG_STD);
4752  setFlag(res,FLAG_TWOSTD);
4753  return FALSE;
4754}
4755#endif
4756
4757static BOOLEAN jjTYPEOF(leftv res, leftv v)
4758{
4759  int t=(int)(long)v->data;
4760  switch (t)
4761  {
4762    case INT_CMD:        res->data=omStrDup("int"); break;
4763    case POLY_CMD:       res->data=omStrDup("poly"); break;
4764    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
4765    case STRING_CMD:     res->data=omStrDup("string"); break;
4766    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
4767    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
4768    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
4769    case MODUL_CMD:      res->data=omStrDup("module"); break;
4770    case MAP_CMD:        res->data=omStrDup("map"); break;
4771    case PROC_CMD:       res->data=omStrDup("proc"); break;
4772    case RING_CMD:       res->data=omStrDup("ring"); break;
4773    case QRING_CMD:      res->data=omStrDup("qring"); break;
4774    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
4775    case NUMBER_CMD:     res->data=omStrDup("number"); break;
4776    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
4777    case LIST_CMD:       res->data=omStrDup("list"); break;
4778    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
4779    case LINK_CMD:       res->data=omStrDup("link"); break;
4780    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
4781    case DEF_CMD:
4782    case NONE:           res->data=omStrDup("none"); break;
4783    default:
4784    {
4785      if (t>MAX_TOK)
4786        res->data=omStrDup(getBlackboxName(t));
4787      else
4788        res->data=omStrDup("?unknown type?");
4789      break;
4790    }
4791  }
4792  return FALSE;
4793}
4794static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
4795{
4796  res->data=(char *)pIsUnivariate((poly)v->Data());
4797  return FALSE;
4798}
4799static BOOLEAN jjVAR1(leftv res, leftv v)
4800{
4801  int i=(int)(long)v->Data();
4802  if ((0<i) && (i<=currRing->N))
4803  {
4804    poly p=pOne();
4805    pSetExp(p,i,1);
4806    pSetm(p);
4807    res->data=(char *)p;
4808  }
4809  else
4810  {
4811    Werror("var number %d out of range 1..%d",i,currRing->N);
4812    return TRUE;
4813  }
4814  return FALSE;
4815}
4816static BOOLEAN jjVARSTR1(leftv res, leftv v)
4817{
4818  if (currRing==NULL)
4819  {
4820    WerrorS("no ring active");
4821    return TRUE;
4822  }
4823  int i=(int)(long)v->Data();
4824  if ((0<i) && (i<=currRing->N))
4825    res->data=omStrDup(currRing->names[i-1]);
4826  else
4827  {
4828    Werror("var number %d out of range 1..%d",i,currRing->N);
4829    return TRUE;
4830  }
4831  return FALSE;
4832}
4833static BOOLEAN jjVDIM(leftv res, leftv v)
4834{
4835  assumeStdFlag(v);
4836  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
4837  return FALSE;
4838}
4839BOOLEAN jjWAIT1ST1(leftv res, leftv u)
4840{
4841// input: u: a list with links of type
4842//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4843// returns: -1:  the read state of all links is eof
4844//          i>0: (at least) u[i] is ready
4845  lists Lforks = (lists)u->Data();
4846  int i = slStatusSsiL(Lforks, -1);
4847  if(i == -2) /* error */
4848  {
4849    return TRUE;
4850  }
4851  res->data = (void*)(long)i;
4852  return FALSE;
4853}
4854BOOLEAN jjWAITALL1(leftv res, leftv u)
4855{
4856// input: u: a list with links of type
4857//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4858// returns: -1: the read state of all links is eof
4859//           1: all links are ready
4860//              (caution: at least one is ready, but some maybe dead)
4861  lists Lforks = (lists)u->CopyD();
4862  int i;
4863  int j = -1;
4864  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
4865  {
4866    i = slStatusSsiL(Lforks, -1);
4867    if(i == -2) /* error */
4868    {
4869      return TRUE;
4870    }
4871    if(i == -1)
4872    {
4873      break;
4874    }
4875    j = 1;
4876    Lforks->m[i-1].CleanUp();
4877    Lforks->m[i-1].rtyp=DEF_CMD;
4878    Lforks->m[i-1].data=NULL;
4879  }
4880  res->data = (void*)(long)j;
4881  Lforks->Clean();
4882  return FALSE;
4883}
4884static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
4885{
4886  char * s=(char *)v->CopyD();
4887  char libnamebuf[256];
4888  lib_types LT = type_of_LIB(s, libnamebuf);
4889#ifdef HAVE_DYNAMIC_LOADING
4890  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
4891#endif /* HAVE_DYNAMIC_LOADING */
4892  switch(LT)
4893  {
4894      default:
4895      case LT_NONE:
4896        Werror("%s: unknown type", s);
4897        break;
4898      case LT_NOTFOUND:
4899        Werror("cannot open %s", s);
4900        break;
4901
4902      case LT_SINGULAR:
4903      {
4904        char *plib = iiConvName(s);
4905        idhdl pl = IDROOT->get(plib,0);
4906        if (pl==NULL)
4907        {
4908          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
4909          IDPACKAGE(pl)->language = LANG_SINGULAR;
4910          IDPACKAGE(pl)->libname=omStrDup(plib);
4911        }
4912        else if (IDTYP(pl)!=PACKAGE_CMD)
4913        {
4914          Werror("can not create package `%s`",plib);
4915          omFree(plib);
4916          return TRUE;
4917        }
4918        package savepack=currPack;
4919        currPack=IDPACKAGE(pl);
4920        IDPACKAGE(pl)->loaded=TRUE;
4921        char libnamebuf[256];
4922        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
4923        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
4924        currPack=savepack;
4925        IDPACKAGE(pl)->loaded=(!bo);
4926        return bo;
4927      }
4928      case LT_MACH_O:
4929      case LT_ELF:
4930      case LT_HPUX:
4931#ifdef HAVE_DYNAMIC_LOADING
4932        return load_modules(s, libnamebuf, autoexport);
4933#else /* HAVE_DYNAMIC_LOADING */
4934        WerrorS("Dynamic modules are not supported by this version of Singular");
4935        break;
4936#endif /* HAVE_DYNAMIC_LOADING */
4937  }
4938  return TRUE;
4939}
4940
4941#ifdef INIT_BUG
4942#define XS(A) -((short)A)
4943#define jjstrlen       (proc1)1
4944#define jjpLength      (proc1)2
4945#define jjidElem       (proc1)3
4946#define jjmpDetBareiss (proc1)4
4947#define jjidFreeModule (proc1)5
4948#define jjidVec2Ideal  (proc1)6
4949#define jjrCharStr     (proc1)7
4950#ifndef MDEBUG
4951#define jjpHead        (proc1)8
4952#endif
4953#define jjidHead       (proc1)9
4954#define jjidMinBase    (proc1)11
4955#define jjsyMinBase    (proc1)12
4956#define jjpMaxComp     (proc1)13
4957#define jjmpTrace      (proc1)14
4958#define jjmpTransp     (proc1)15
4959#define jjrOrdStr      (proc1)16
4960#define jjrVarStr      (proc1)18
4961#define jjrParStr      (proc1)19
4962#define jjCOUNT_RES    (proc1)22
4963#define jjDIM_R        (proc1)23
4964#define jjidTransp     (proc1)24
4965
4966extern struct sValCmd1 dArith1[];
4967void jjInitTab1()
4968{
4969  int i=0;
4970  for (;dArith1[i].cmd!=0;i++)
4971  {
4972    if (dArith1[i].res<0)
4973    {
4974      switch ((int)dArith1[i].p)
4975      {
4976        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
4977        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
4978        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
4979        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
4980#ifndef HAVE_FACTORY
4981        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
4982#endif
4983        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
4984        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
4985#ifndef MDEBUG
4986        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
4987#endif
4988        case (int)jjidHead:       dArith1[i].p=(proc1)idHead; break;
4989        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
4990        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
4991        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
4992        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
4993        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
4994        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
4995        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
4996        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
4997        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
4998        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
4999        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5000        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5001      }
5002    }
5003  }
5004}
5005#else
5006#if defined(PROC_BUG)
5007#define XS(A) A
5008static BOOLEAN jjstrlen(leftv res, leftv v)
5009{
5010  res->data = (char *)strlen((char *)v->Data());
5011  return FALSE;
5012}
5013static BOOLEAN jjpLength(leftv res, leftv v)
5014{
5015  res->data = (char *)pLength((poly)v->Data());
5016  return FALSE;
5017}
5018static BOOLEAN jjidElem(leftv res, leftv v)
5019{
5020  res->data = (char *)idElem((ideal)v->Data());
5021  return FALSE;
5022}
5023static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5024{
5025  res->data = (char *)mpDetBareiss((matrix)v->Data());
5026  return FALSE;
5027}
5028static BOOLEAN jjidFreeModule(leftv res, leftv v)
5029{
5030  res->data = (char *)idFreeModule((int)(long)v->Data());
5031  return FALSE;
5032}
5033static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5034{
5035  res->data = (char *)idVec2Ideal((poly)v->Data());
5036  return FALSE;
5037}
5038static BOOLEAN jjrCharStr(leftv res, leftv v)
5039{
5040  res->data = rCharStr((ring)v->Data());
5041  return FALSE;
5042}
5043#ifndef MDEBUG
5044static BOOLEAN jjpHead(leftv res, leftv v)
5045{
5046  res->data = (char *)pHead((poly)v->Data());
5047  return FALSE;
5048}
5049#endif
5050static BOOLEAN jjidHead(leftv res, leftv v)
5051{
5052  res->data = (char *)idHead((ideal)v->Data());
5053  return FALSE;
5054}
5055static BOOLEAN jjidMinBase(leftv res, leftv v)
5056{
5057  res->data = (char *)idMinBase((ideal)v->Data());
5058  return FALSE;
5059}
5060static BOOLEAN jjsyMinBase(leftv res, leftv v)
5061{
5062  res->data = (char *)syMinBase((ideal)v->Data());
5063  return FALSE;
5064}
5065static BOOLEAN jjpMaxComp(leftv res, leftv v)
5066{
5067  res->data = (char *)pMaxComp((poly)v->Data());
5068  return FALSE;
5069}
5070static BOOLEAN jjmpTrace(leftv res, leftv v)
5071{
5072  res->data = (char *)mpTrace((matrix)v->Data());
5073  return FALSE;
5074}
5075static BOOLEAN jjmpTransp(leftv res, leftv v)
5076{
5077  res->data = (char *)mpTransp((matrix)v->Data());
5078  return FALSE;
5079}
5080static BOOLEAN jjrOrdStr(leftv res, leftv v)
5081{
5082  res->data = rOrdStr((ring)v->Data());
5083  return FALSE;
5084}
5085static BOOLEAN jjrVarStr(leftv res, leftv v)
5086{
5087  res->data = rVarStr((ring)v->Data());
5088  return FALSE;
5089}
5090static BOOLEAN jjrParStr(leftv res, leftv v)
5091{
5092  res->data = rParStr((ring)v->Data());
5093  return FALSE;
5094}
5095static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5096{
5097  res->data=(char *)sySize((syStrategy)v->Data());
5098  return FALSE;
5099}
5100static BOOLEAN jjDIM_R(leftv res, leftv v)
5101{
5102  res->data = (char *)syDim((syStrategy)v->Data());
5103  return FALSE;
5104}
5105static BOOLEAN jjidTransp(leftv res, leftv v)
5106{
5107  res->data = (char *)idTransp((ideal)v->Data());
5108  return FALSE;
5109}
5110#else
5111#define XS(A)          -((short)A)
5112#define jjstrlen       (proc1)strlen
5113#define jjpLength      (proc1)pLength
5114#define jjidElem       (proc1)idElem
5115#define jjmpDetBareiss (proc1)mpDetBareiss
5116#define jjidFreeModule (proc1)idFreeModule
5117#define jjidVec2Ideal  (proc1)idVec2Ideal
5118#define jjrCharStr     (proc1)rCharStr
5119#ifndef MDEBUG
5120#define jjpHead        (proc1)pHeadProc
5121#endif
5122#define jjidHead       (proc1)idHead
5123#define jjidMinBase    (proc1)idMinBase
5124#define jjsyMinBase    (proc1)syMinBase
5125#define jjpMaxComp     (proc1)pMaxCompProc
5126#define jjmpTrace      (proc1)mpTrace
5127#define jjmpTransp     (proc1)mpTransp
5128#define jjrOrdStr      (proc1)rOrdStr
5129#define jjrVarStr      (proc1)rVarStr
5130#define jjrParStr      (proc1)rParStr
5131#define jjCOUNT_RES    (proc1)sySize
5132#define jjDIM_R        (proc1)syDim
5133#define jjidTransp     (proc1)idTransp
5134#endif
5135#endif
5136static BOOLEAN jjnInt(leftv res, leftv u)
5137{
5138  number n=(number)u->Data();
5139  res->data=(char *)(long)n_Int(n,currRing);
5140  return FALSE;
5141}
5142static BOOLEAN jjnlInt(leftv res, leftv u)
5143{
5144  number n=(number)u->Data();
5145  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
5146  return FALSE;
5147}
5148/*=================== operations with 3 args.: static proc =================*/
5149/* must be ordered: first operations for chars (infix ops),
5150 * then alphabetically */
5151static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5152{
5153  char *s= (char *)u->Data();
5154  int   r = (int)(long)v->Data();
5155  int   c = (int)(long)w->Data();
5156  int l = strlen(s);
5157
5158  if ( (r<1) || (r>l) || (c<0) )
5159  {
5160    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5161    return TRUE;
5162  }
5163  res->data = (char *)omAlloc((long)(c+1));
5164  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5165  return FALSE;
5166}
5167static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5168{
5169  intvec *iv = (intvec *)u->Data();
5170  int   r = (int)(long)v->Data();
5171  int   c = (int)(long)w->Data();
5172  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5173  {
5174    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5175           r,c,u->Fullname(),iv->rows(),iv->cols());
5176    return TRUE;
5177  }
5178  res->data=u->data; u->data=NULL;
5179  res->rtyp=u->rtyp; u->rtyp=0;
5180  res->name=u->name; u->name=NULL;
5181  Subexpr e=jjMakeSub(v);
5182          e->next=jjMakeSub(w);
5183  if (u->e==NULL) res->e=e;
5184  else
5185  {
5186    Subexpr h=u->e;
5187    while (h->next!=NULL) h=h->next;
5188    h->next=e;
5189    res->e=u->e;
5190    u->e=NULL;
5191  }
5192  return FALSE;
5193}
5194static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5195{
5196  matrix m= (matrix)u->Data();
5197  int   r = (int)(long)v->Data();
5198  int   c = (int)(long)w->Data();
5199  //Print("gen. elem %d, %d\n",r,c);
5200  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5201  {
5202    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5203      MATROWS(m),MATCOLS(m));
5204    return TRUE;
5205  }
5206  res->data=u->data; u->data=NULL;
5207  res->rtyp=u->rtyp; u->rtyp=0;
5208  res->name=u->name; u->name=NULL;
5209  Subexpr e=jjMakeSub(v);
5210          e->next=jjMakeSub(w);
5211  if (u->e==NULL)
5212    res->e=e;
5213  else
5214  {
5215    Subexpr h=u->e;
5216    while (h->next!=NULL) h=h->next;
5217    h->next=e;
5218    res->e=u->e;
5219    u->e=NULL;
5220  }
5221  return FALSE;
5222}
5223static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5224{
5225  sleftv t;
5226  sleftv ut;
5227  leftv p=NULL;
5228  intvec *iv=(intvec *)w->Data();
5229  int l;
5230  BOOLEAN nok;
5231
5232  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5233  {
5234    WerrorS("cannot build expression lists from unnamed objects");
5235    return TRUE;
5236  }
5237  memcpy(&ut,u,sizeof(ut));
5238  memset(&t,0,sizeof(t));
5239  t.rtyp=INT_CMD;
5240  for (l=0;l< iv->length(); l++)
5241  {
5242    t.data=(char *)(long)((*iv)[l]);
5243    if (p==NULL)
5244    {
5245      p=res;
5246    }
5247    else
5248    {
5249      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5250      p=p->next;
5251    }
5252    memcpy(u,&ut,sizeof(ut));
5253    if (u->Typ() == MATRIX_CMD)
5254      nok=jjBRACK_Ma(p,u,v,&t);
5255    else /* INTMAT_CMD */
5256      nok=jjBRACK_Im(p,u,v,&t);
5257    if (nok)
5258    {
5259      while (res->next!=NULL)
5260      {
5261        p=res->next->next;
5262        omFreeBin((ADDRESS)res->next, sleftv_bin);
5263        // res->e aufraeumen !!!!
5264        res->next=p;
5265      }
5266      return TRUE;
5267    }
5268  }
5269  return FALSE;
5270}
5271static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5272{
5273  sleftv t;
5274  sleftv ut;
5275  leftv p=NULL;
5276  intvec *iv=(intvec *)v->Data();
5277  int l;
5278  BOOLEAN nok;
5279
5280  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5281  {
5282    WerrorS("cannot build expression lists from unnamed objects");
5283    return TRUE;
5284  }
5285  memcpy(&ut,u,sizeof(ut));
5286  memset(&t,0,sizeof(t));
5287  t.rtyp=INT_CMD;
5288  for (l=0;l< iv->length(); l++)
5289  {
5290    t.data=(char *)(long)((*iv)[l]);
5291    if (p==NULL)
5292    {
5293      p=res;
5294    }
5295    else
5296    {
5297      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5298      p=p->next;
5299    }
5300    memcpy(u,&ut,sizeof(ut));
5301    if (u->Typ() == MATRIX_CMD)
5302      nok=jjBRACK_Ma(p,u,&t,w);
5303    else /* INTMAT_CMD */
5304      nok=jjBRACK_Im(p,u,&t,w);
5305    if (nok)
5306    {
5307      while (res->next!=NULL)
5308      {
5309        p=res->next->next;
5310        omFreeBin((ADDRESS)res->next, sleftv_bin);
5311        // res->e aufraeumen !!
5312        res->next=p;
5313      }
5314      return TRUE;
5315    }
5316  }
5317  return FALSE;
5318}
5319static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5320{
5321  sleftv t1,t2,ut;
5322  leftv p=NULL;
5323  intvec *vv=(intvec *)v->Data();
5324  intvec *wv=(intvec *)w->Data();
5325  int vl;
5326  int wl;
5327  BOOLEAN nok;
5328
5329  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5330  {
5331    WerrorS("cannot build expression lists from unnamed objects");
5332    return TRUE;
5333  }
5334  memcpy(&ut,u,sizeof(ut));
5335  memset(&t1,0,sizeof(sleftv));
5336  memset(&t2,0,sizeof(sleftv));
5337  t1.rtyp=INT_CMD;
5338  t2.rtyp=INT_CMD;
5339  for (vl=0;vl< vv->length(); vl++)
5340  {
5341    t1.data=(char *)(long)((*vv)[vl]);
5342    for (wl=0;wl< wv->length(); wl++)
5343    {
5344      t2.data=(char *)(long)((*wv)[wl]);
5345      if (p==NULL)
5346      {
5347        p=res;
5348      }
5349      else
5350      {
5351        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5352        p=p->next;
5353      }
5354      memcpy(u,&ut,sizeof(ut));
5355      if (u->Typ() == MATRIX_CMD)
5356        nok=jjBRACK_Ma(p,u,&t1,&t2);
5357      else /* INTMAT_CMD */
5358        nok=jjBRACK_Im(p,u,&t1,&t2);
5359      if (nok)
5360      {
5361        res->CleanUp();
5362        return TRUE;
5363      }
5364    }
5365  }
5366  return FALSE;
5367}
5368static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5369{
5370  v->next=(leftv)omAllocBin(sleftv_bin);
5371  memcpy(v->next,w,sizeof(sleftv));
5372  memset(w,0,sizeof(sleftv));
5373  return jjPROC(res,u,v);
5374}
5375static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5376{
5377  u->next=(leftv)omAllocBin(sleftv_bin);
5378  memcpy(u->next,v,sizeof(sleftv));
5379  u->next->next=(leftv)omAllocBin(sleftv_bin);
5380  memcpy(u->next->next,w,sizeof(sleftv));
5381  BOOLEAN r=iiExprArithM(res,u,iiOp);
5382  v->Init();
5383  w->Init();
5384  //w->rtyp=0; w->data=NULL;
5385  // iiExprArithM did the CleanUp
5386  return r;
5387}
5388static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5389{
5390  intvec *iv;
5391  ideal m;
5392  lists l=(lists)omAllocBin(slists_bin);
5393  int k=(int)(long)w->Data();
5394  if (k>=0)
5395  {
5396    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5397    l->Init(2);
5398    l->m[0].rtyp=MODUL_CMD;
5399    l->m[1].rtyp=INTVEC_CMD;
5400    l->m[0].data=(void *)m;
5401    l->m[1].data=(void *)iv;
5402  }
5403  else
5404  {
5405    m=smCallSolv((ideal)u->Data());
5406    l->Init(1);
5407    l->m[0].rtyp=IDEAL_CMD;
5408    l->m[0].data=(void *)m;
5409  }
5410  res->data = (char *)l;
5411  return FALSE;
5412}
5413static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5414{
5415  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5416  {
5417    WerrorS("3rd argument must be a name of a matrix");
5418    return TRUE;
5419  }
5420  ideal i=(ideal)u->Data();
5421  int rank=(int)i->rank;
5422  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5423  if (r) return TRUE;
5424  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5425  return FALSE;
5426}
5427static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5428{
5429  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5430           (ideal)(v->Data()),(poly)(w->Data()));
5431  return FALSE;
5432}
5433static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5434{
5435  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5436  {
5437    WerrorS("3rd argument must be a name of a matrix");
5438    return TRUE;
5439  }
5440  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5441  poly p=(poly)u->CopyD(POLY_CMD);
5442  ideal i=idInit(1,1);
5443  i->m[0]=p;
5444  sleftv t;
5445  memset(&t,0,sizeof(t));
5446  t.data=(char *)i;
5447  t.rtyp=IDEAL_CMD;
5448  int rank=1;
5449  if (u->Typ()==VECTOR_CMD)
5450  {
5451    i->rank=rank=pMaxComp(p);
5452    t.rtyp=MODUL_CMD;
5453  }
5454  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5455  t.CleanUp();
5456  if (r) return TRUE;
5457  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5458  return FALSE;
5459}
5460static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5461{
5462  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5463    (intvec *)w->Data());
5464  //setFlag(res,FLAG_STD);
5465  return FALSE;
5466}
5467static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5468{
5469  /*4
5470  * look for the substring what in the string where
5471  * starting at position n
5472  * return the position of the first char of what in where
5473  * or 0
5474  */
5475  int n=(int)(long)w->Data();
5476  char *where=(char *)u->Data();
5477  char *what=(char *)v->Data();
5478  char *found;
5479  if ((1>n)||(n>(int)strlen(where)))
5480  {
5481    Werror("start position %d out of range",n);
5482    return TRUE;
5483  }
5484  found = strchr(where+n-1,*what);
5485  if (*(what+1)!='\0')
5486  {
5487    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5488    {
5489      found=strchr(found+1,*what);
5490    }
5491  }
5492  if (found != NULL)
5493  {
5494    res->data=(char *)((found-where)+1);
5495  }
5496  return FALSE;
5497}
5498static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5499{
5500  if ((int)(long)w->Data()==0)
5501    res->data=(char *)walkProc(u,v);
5502  else
5503    res->data=(char *)fractalWalkProc(u,v);
5504  setFlag( res, FLAG_STD );
5505  return FALSE;
5506}
5507static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5508{
5509  intvec *wdegree=(intvec*)w->Data();
5510  if (wdegree->length()!=pVariables)
5511  {
5512    Werror("weight vector must have size %d, not %d",
5513           pVariables,wdegree->length());
5514    return TRUE;
5515  }
5516#ifdef HAVE_RINGS
5517  if (rField_is_Ring_Z(currRing))
5518  {
5519    ring origR = currRing;
5520    ring tempR = rCopy(origR);
5521    tempR->ringtype = 0; tempR->ch = 0;
5522    rComplete(tempR);
5523    ideal uid = (ideal)u->Data();
5524    rChangeCurrRing(tempR);
5525    ideal uu = idrCopyR(uid, origR, currRing);
5526    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5527    uuAsLeftv.rtyp = IDEAL_CMD;
5528    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5529    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5530    assumeStdFlag(&uuAsLeftv);
5531    Print("// NOTE: computation of Hilbert series etc. is being\n");
5532    Print("//       performed for generic fibre, that is, over Q\n");
5533    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5534    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5535    int returnWithTrue = 1;
5536    switch((int)(long)v->Data())
5537    {
5538      case 1:
5539        res->data=(void *)iv;
5540        returnWithTrue = 0;
5541      case 2:
5542        res->data=(void *)hSecondSeries(iv);
5543        delete iv;
5544        returnWithTrue = 0;
5545    }
5546    if (returnWithTrue)
5547    {
5548      WerrorS(feNotImplemented);
5549      delete iv;
5550    }
5551    idDelete(&uu);
5552    rChangeCurrRing(origR);
5553    rDelete(tempR);
5554    if (returnWithTrue) return TRUE; else return FALSE;
5555  }
5556#endif
5557  assumeStdFlag(u);
5558  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5559  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5560  switch((int)(long)v->Data())
5561  {
5562    case 1:
5563      res->data=(void *)iv;
5564      return FALSE;
5565    case 2:
5566      res->data=(void *)hSecondSeries(iv);
5567      delete iv;
5568      return FALSE;
5569  }
5570  WerrorS(feNotImplemented);
5571  delete iv;
5572  return TRUE;
5573}
5574static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5575{
5576  PrintS("TODO\n");
5577  int i=pVar((poly)v->Data());
5578  if (i==0)
5579  {
5580    WerrorS("ringvar expected");
5581    return TRUE;
5582  }
5583  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5584  int d=pWTotaldegree(p);
5585  pLmDelete(p);
5586  if (d==1)
5587    res->data = (char *)idHomogen((ideal)u->Data(),i);
5588  else
5589    WerrorS("variable must have weight 1");
5590  return (d!=1);
5591}
5592static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5593{
5594  PrintS("TODO\n");
5595  int i=pVar((poly)v->Data());
5596  if (i==0)
5597  {
5598    WerrorS("ringvar expected");
5599    return TRUE;
5600  }
5601  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5602  int d=pWTotaldegree(p);
5603  pLmDelete(p);
5604  if (d==1)
5605    res->data = (char *)pHomogen((poly)u->Data(),i);
5606  else
5607    WerrorS("variable must have weight 1");
5608  return (d!=1);
5609}
5610static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5611{
5612  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5613  intvec* arg = (intvec*) u->Data();
5614  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5615
5616  for (i=0; i<n; i++)
5617  {
5618    (*im)[i] = (*arg)[i];
5619  }
5620
5621  res->data = (char *)im;
5622  return FALSE;
5623}
5624static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5625{
5626  short *iw=iv2array((intvec *)w->Data());
5627  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5628  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
5629  return FALSE;
5630}
5631static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5632{
5633  if (!pIsUnit((poly)v->Data()))
5634  {
5635    WerrorS("2nd argument must be a unit");
5636    return TRUE;
5637  }
5638  res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
5639  return FALSE;
5640}
5641static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5642{
5643  res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
5644                             (intvec *)w->Data());
5645  return FALSE;
5646}
5647static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5648{
5649  if (!mpIsDiagUnit((matrix)v->Data()))
5650  {
5651    WerrorS("2nd argument must be a diagonal matrix of units");
5652    return TRUE;
5653  }
5654  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5655                               (matrix)v->CopyD());
5656  return FALSE;
5657}
5658static BOOLEAN currRingIsOverIntegralDomain ()
5659{
5660  /* true for fields and Z, false otherwise */
5661  if (rField_is_Ring_PtoM()) return FALSE;
5662  if (rField_is_Ring_2toM()) return FALSE;
5663  if (rField_is_Ring_ModN()) return FALSE;
5664  return TRUE;
5665}
5666static BOOLEAN jjMINOR_M(leftv res, leftv v)
5667{
5668  /* Here's the use pattern for the minor command:
5669        minor ( matrix_expression m, int_expression minorSize,
5670                optional ideal_expression IasSB, optional int_expression k,
5671                optional string_expression algorithm,
5672                optional int_expression cachedMinors,
5673                optional int_expression cachedMonomials )
5674     This method here assumes that there are at least two arguments.
5675     - If IasSB is present, it must be a std basis. All minors will be
5676       reduced w.r.t. IasSB.
5677     - If k is absent, all non-zero minors will be computed.
5678       If k is present and k > 0, the first k non-zero minors will be
5679       computed.
5680       If k is present and k < 0, the first |k| minors (some of which
5681       may be zero) will be computed.
5682       If k is present and k = 0, an error is reported.
5683     - If algorithm is absent, all the following arguments must be absent too.
5684       In this case, a heuristic picks the best-suited algorithm (among
5685       Bareiss, Laplace, and Laplace with caching).
5686       If algorithm is present, it must be one of "Bareiss", "bareiss",
5687       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5688       "cache" two more arguments may be given, determining how many entries
5689       the cache may have at most, and how many cached monomials there are at
5690       most. (Cached monomials are counted over all cached polynomials.)
5691       If these two additional arguments are not provided, 200 and 100000
5692       will be used as defaults.
5693  */
5694  matrix m;
5695  leftv u=v->next;
5696  v->next=NULL;
5697  int v_typ=v->Typ();
5698  if (v_typ==MATRIX_CMD)
5699  {
5700     m = (const matrix)v->Data();
5701  }
5702  else
5703  {
5704    if (v_typ==0)
5705    {
5706      Werror("`%s` is undefined",v->Fullname());
5707      return TRUE;
5708    }
5709    // try to convert to MATRIX:
5710    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5711    BOOLEAN bo;
5712    sleftv tmp;
5713    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5714    else bo=TRUE;
5715    if (bo)
5716    {
5717      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5718      return TRUE;
5719    }
5720    m=(matrix)tmp.data;
5721  }
5722  const int mk = (const int)(long)u->Data();
5723  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5724  bool noCacheMinors = true; bool noCacheMonomials = true;
5725  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5726
5727  /* here come the different cases of correct argument sets */
5728  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5729  {
5730    IasSB = (ideal)u->next->Data();
5731    noIdeal = false;
5732    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5733    {
5734      k = (int)(long)u->next->next->Data();
5735      noK = false;
5736      assume(k != 0);
5737      if ((u->next->next->next != NULL) &&
5738          (u->next->next->next->Typ() == STRING_CMD))
5739      {
5740        algorithm = (char*)u->next->next->next->Data();
5741        noAlgorithm = false;
5742        if ((u->next->next->next->next != NULL) &&
5743            (u->next->next->next->next->Typ() == INT_CMD))
5744        {
5745          cacheMinors = (int)(long)u->next->next->next->next->Data();
5746          noCacheMinors = false;
5747          if ((u->next->next->next->next->next != NULL) &&
5748              (u->next->next->next->next->next->Typ() == INT_CMD))
5749          {
5750            cacheMonomials =
5751               (int)(long)u->next->next->next->next->next->Data();
5752            noCacheMonomials = false;
5753          }
5754        }
5755      }
5756    }
5757  }
5758  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5759  {
5760    k = (int)(long)u->next->Data();
5761    noK = false;
5762    assume(k != 0);
5763    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5764    {
5765      algorithm = (char*)u->next->next->Data();
5766      noAlgorithm = false;
5767      if ((u->next->next->next != NULL) &&
5768          (u->next->next->next->Typ() == INT_CMD))
5769      {
5770        cacheMinors = (int)(long)u->next->next->next->Data();
5771        noCacheMinors = false;
5772        if ((u->next->next->next->next != NULL) &&
5773            (u->next->next->next->next->Typ() == INT_CMD))
5774        {
5775          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5776          noCacheMonomials = false;
5777        }
5778      }
5779    }
5780  }
5781  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5782  {
5783    algorithm = (char*)u->next->Data();
5784    noAlgorithm = false;
5785    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5786    {
5787      cacheMinors = (int)(long)u->next->next->Data();
5788      noCacheMinors = false;
5789      if ((u->next->next->next != NULL) &&
5790          (u->next->next->next->Typ() == INT_CMD))
5791      {
5792        cacheMonomials = (int)(long)u->next->next->next->Data();
5793        noCacheMonomials = false;
5794      }
5795    }
5796  }
5797
5798  /* upper case conversion for the algorithm if present */
5799  if (!noAlgorithm)
5800  {
5801    if (strcmp(algorithm, "bareiss") == 0)
5802      algorithm = (char*)"Bareiss";
5803    if (strcmp(algorithm, "laplace") == 0)
5804      algorithm = (char*)"Laplace";
5805    if (strcmp(algorithm, "cache") == 0)
5806      algorithm = (char*)"Cache";
5807  }
5808
5809  v->next=u;
5810  /* here come some tests */
5811  if (!noIdeal)
5812  {
5813    assumeStdFlag(u->next);
5814  }
5815  if ((!noK) && (k == 0))
5816  {
5817    WerrorS("Provided number of minors to be computed is zero.");
5818    return TRUE;
5819  }
5820  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
5821      && (strcmp(algorithm, "Laplace") != 0)
5822      && (strcmp(algorithm, "Cache") != 0))
5823  {
5824    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
5825    return TRUE;
5826  }
5827  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
5828      && (!currRingIsOverIntegralDomain()))
5829  {
5830    Werror("Bareiss algorithm not defined over coefficient rings %s",
5831           "with zero divisors.");
5832    return TRUE;
5833  }
5834  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
5835  {
5836    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
5837           m->rows(), m->cols());
5838    return TRUE;
5839  }
5840  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
5841      && (noCacheMinors || noCacheMonomials))
5842  {
5843    cacheMinors = 200;
5844    cacheMonomials = 100000;
5845  }
5846
5847  /* here come the actual procedure calls */
5848  if (noAlgorithm)
5849    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
5850                                       (noIdeal ? 0 : IasSB), false);
5851  else if (strcmp(algorithm, "Cache") == 0)
5852    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
5853                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
5854                                   cacheMonomials, false);
5855  else
5856    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
5857                              (noIdeal ? 0 : IasSB), false);
5858  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
5859  res->rtyp = IDEAL_CMD;
5860  return FALSE;
5861}
5862static BOOLEAN jjNEWSTRUCT3(leftv res, leftv u, leftv v, leftv w)
5863{
5864  // u: the name of the new type
5865  // v: the parent type
5866  // w: the elements
5867  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
5868                                            (const char *)w->Data());
5869  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
5870  return d==NULL;
5871}
5872static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
5873{
5874  // handles preimage(r,phi,i) and kernel(r,phi)
5875  idhdl h;
5876  ring rr;
5877  map mapping;
5878  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
5879
5880  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
5881  {
5882    WerrorS("2nd/3rd arguments must have names");
5883    return TRUE;
5884  }
5885  rr=(ring)u->Data();
5886  const char *ring_name=u->Name();
5887  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
5888  {
5889    if (h->typ==MAP_CMD)
5890    {
5891      mapping=IDMAP(h);
5892      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
5893      if ((preim_ring==NULL)
5894      || (IDRING(preim_ring)!=currRing))
5895      {
5896        Werror("preimage ring `%s` is not the basering",mapping->preimage);
5897        return TRUE;
5898      }
5899    }
5900    else if (h->typ==IDEAL_CMD)
5901    {
5902      mapping=IDMAP(h);
5903    }
5904    else
5905    {
5906      Werror("`%s` is no map nor ideal",IDID(h));
5907      return TRUE;
5908    }
5909  }
5910  else
5911  {
5912    Werror("`%s` is not defined in `%s`",v->name,ring_name);
5913    return TRUE;
5914  }
5915  ideal image;
5916  if (kernel_cmd) image=idInit(1,1);
5917  else
5918  {
5919    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
5920    {
5921      if (h->typ==IDEAL_CMD)
5922      {
5923        image=IDIDEAL(h);
5924      }
5925      else
5926      {
5927        Werror("`%s` is no ideal",IDID(h));
5928        return TRUE;
5929      }
5930    }
5931    else
5932    {
5933      Werror("`%s` is not defined in `%s`",w->name,ring_name);
5934      return TRUE;
5935    }
5936  }
5937  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
5938  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
5939  {
5940    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
5941  }
5942  res->data=(char *)maGetPreimage(rr,mapping,image);
5943  if (kernel_cmd) idDelete(&image);
5944  return (res->data==NULL/* is of type ideal, should not be NULL*/);
5945}
5946static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
5947{
5948  int di, k;
5949  int i=(int)(long)u->Data();
5950  int r=(int)(long)v->Data();
5951  int c=(int)(long)w->Data();
5952  if ((r<=0) || (c<=0)) return TRUE;
5953  intvec *iv = new intvec(r, c, 0);
5954  if (iv->rows()==0)
5955  {
5956    delete iv;
5957    return TRUE;
5958  }
5959  if (i!=0)
5960  {
5961    if (i<0) i = -i;
5962    di = 2 * i + 1;
5963    for (k=0; k<iv->length(); k++)
5964    {
5965      (*iv)[k] = ((siRand() % di) - i);
5966    }
5967  }
5968  res->data = (char *)iv;
5969  return FALSE;
5970}
5971static BOOLEAN jjSUBST_Test(leftv v,leftv w,
5972  int &ringvar, poly &monomexpr)
5973{
5974  monomexpr=(poly)w->Data();
5975  poly p=(poly)v->Data();
5976  #if 0
5977  if (pLength(monomexpr)>1)
5978  {
5979    Werror("`%s` substitutes a ringvar only by a term",
5980      Tok2Cmdname(SUBST_CMD));
5981    return TRUE;
5982  }
5983  #endif
5984  if (!(ringvar=pVar(p)))
5985  {
5986    if (rField_is_Extension(currRing))
5987    {
5988      assume(currRing->extRing!=NULL);
5989      lnumber n=(lnumber)pGetCoeff(p);
5990      ringvar=-p_Var(n->z,currRing->extRing);
5991    }
5992    if(ringvar==0)
5993    {
5994      WerrorS("ringvar/par expected");
5995      return TRUE;
5996    }
5997  }
5998  return FALSE;
5999}
6000static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6001{
6002  int ringvar;
6003  poly monomexpr;
6004  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6005  if (nok) return TRUE;
6006  poly p=(poly)u->Data();
6007  if (ringvar>0)
6008  {
6009    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6010    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6011    {
6012      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6013      //return TRUE;
6014    }
6015    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6016      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6017    else
6018      res->data= pSubstPoly(p,ringvar,monomexpr);
6019  }
6020  else
6021  {
6022    res->data=pSubstPar(p,-ringvar,monomexpr);
6023  }
6024  return FALSE;
6025}
6026static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6027{
6028  int ringvar;
6029  poly monomexpr;
6030  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6031  if (nok) return TRUE;
6032  if (ringvar>0)
6033  {
6034    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6035      res->data = idSubst((ideal)u->CopyD(res->rtyp),ringvar,monomexpr);
6036    else
6037      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6038  }
6039  else
6040  {
6041    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6042  }
6043  return FALSE;
6044}
6045// we do not want to have jjSUBST_Id_X inlined:
6046static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6047                            int input_type);
6048static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6049{
6050  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6051}
6052static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6053{
6054  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6055}
6056static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6057{
6058  sleftv tmp;
6059  memset(&tmp,0,sizeof(tmp));
6060  // do not check the result, conversion from int/number to poly works always
6061  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6062  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6063  tmp.CleanUp();
6064  return b;
6065}
6066static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6067{
6068  int mi=(int)(long)v->Data();
6069  int ni=(int)(long)w->Data();
6070  if ((mi<1)||(ni<1))
6071  {
6072    WerrorS("matrix dimensions must be positive");
6073    return TRUE;
6074  }
6075  matrix m=mpNew(mi,ni);
6076  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6077  int i=si_min(IDELEMS(I),mi*ni);
6078  //for(i=i-1;i>=0;i--)
6079  //{
6080  //  m->m[i]=I->m[i];
6081  //  I->m[i]=NULL;
6082  //}
6083  memcpy(m->m,I->m,i*sizeof(poly));
6084  memset(I->m,0,i*sizeof(poly));
6085  idDelete(&I);
6086  res->data = (char *)m;
6087  return FALSE;
6088}
6089static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6090{
6091  int mi=(int)(long)v->Data();
6092  int ni=(int)(long)w->Data();
6093  if ((mi<1)||(ni<1))
6094  {
6095    WerrorS("matrix dimensions must be positive");
6096    return TRUE;
6097  }
6098  res->data = (char *)idModule2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6099           mi,ni);
6100  return FALSE;
6101}
6102static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6103{
6104  int mi=(int)(long)v->Data();
6105  int ni=(int)(long)w->Data();
6106  if ((mi<1)||(ni<1))
6107  {
6108    WerrorS("matrix dimensions must be positive");
6109    return TRUE;
6110  }
6111  matrix m=mpNew(mi,ni);
6112  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6113  int r=si_min(MATROWS(I),mi);
6114  int c=si_min(MATCOLS(I),ni);
6115  int i,j;
6116  for(i=r;i>0;i--)
6117  {
6118    for(j=c;j>0;j--)
6119    {
6120      MATELEM(m,i,j)=MATELEM(I,i,j);
6121      MATELEM(I,i,j)=NULL;
6122    }
6123  }
6124  idDelete((ideal *)&I);
6125  res->data = (char *)m;
6126  return FALSE;
6127}
6128static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6129{
6130  if (w->rtyp!=IDHDL) return TRUE;
6131  BITSET save_test=test;
6132  int ul= IDELEMS((ideal)u->Data());
6133  int vl= IDELEMS((ideal)v->Data());
6134  ideal m
6135    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6136             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6137  if (m==NULL) return TRUE;
6138  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
6139  test=save_test;
6140  return FALSE;
6141}
6142static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6143{
6144  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6145  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6146  idhdl hv=(idhdl)v->data;
6147  idhdl hw=(idhdl)w->data;
6148  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6149  res->data = (char *)idLiftStd((ideal)u->Data(),
6150                                &(hv->data.umatrix),testHomog,
6151                                &(hw->data.uideal));
6152  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6153  return FALSE;
6154}
6155static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6156{
6157  assumeStdFlag(v);
6158  if (!idIsZeroDim((ideal)v->Data()))
6159  {
6160    Werror("`%s` must be 0-dimensional",v->Name());
6161    return TRUE;
6162  }
6163  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6164    (poly)w->CopyD());
6165  return FALSE;
6166}
6167static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6168{
6169  assumeStdFlag(v);
6170  if (!idIsZeroDim((ideal)v->Data()))
6171  {
6172    Werror("`%s` must be 0-dimensional",v->Name());
6173    return TRUE;
6174  }
6175  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6176    (matrix)w->CopyD());
6177  return FALSE;
6178}
6179static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6180{
6181  assumeStdFlag(v);
6182  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6183    0,(int)(long)w->Data());
6184  return FALSE;
6185}
6186static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6187{
6188  assumeStdFlag(v);
6189  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6190    0,(int)(long)w->Data());
6191  return FALSE;
6192}
6193#ifdef OLD_RES
6194static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6195{
6196  int maxl=(int)v->Data();
6197  ideal u_id=(ideal)u->Data();
6198  int l=0;
6199  resolvente r;
6200  intvec **weights=NULL;
6201  int wmaxl=maxl;
6202  maxl--;
6203  if ((maxl==-1) && (iiOp!=MRES_CMD))
6204    maxl = pVariables-1;
6205  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6206  {
6207    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6208    if (iv!=NULL)
6209    {
6210      l=1;
6211      if (!idTestHomModule(u_id,currQuotient,iv))
6212      {
6213        WarnS("wrong weights");
6214        iv=NULL;
6215      }
6216      else
6217      {
6218        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6219        weights[0] = ivCopy(iv);
6220      }
6221    }
6222    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6223  }
6224  else
6225    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6226  if (r==NULL) return TRUE;
6227  int t3=u->Typ();
6228  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6229  return FALSE;
6230}
6231#endif
6232static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6233{
6234  res->data=(void *)rInit(u,v,w);
6235  return (res->data==NULL);
6236}
6237static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6238{
6239  int yes;
6240  jjSTATUS2(res, u, v);
6241  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6242  omFree((ADDRESS) res->data);
6243  res->data = (void *)(long)yes;
6244  return FALSE;
6245}
6246static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6247{
6248  intvec *vw=(intvec *)w->Data(); // weights of vars
6249  if (vw->length()!=currRing->N)
6250  {
6251    Werror("%d weights for %d variables",vw->length(),currRing->N);
6252    return TRUE;
6253  }
6254  ideal result;
6255  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6256  tHomog hom=testHomog;
6257  ideal u_id=(ideal)(u->Data());
6258  if (ww!=NULL)
6259  {
6260    if (!idTestHomModule(u_id,currQuotient,ww))
6261    {
6262      WarnS("wrong weights");
6263      ww=NULL;
6264    }
6265    else
6266    {
6267      ww=ivCopy(ww);
6268      hom=isHomog;
6269    }
6270  }
6271  result=kStd(u_id,
6272              currQuotient,
6273              hom,
6274              &ww,                  // module weights
6275              (intvec *)v->Data(),  // hilbert series
6276              0,0,                  // syzComp, newIdeal
6277              vw);                  // weights of vars
6278  idSkipZeroes(result);
6279  res->data = (char *)result;
6280  setFlag(res,FLAG_STD);
6281  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6282  return FALSE;
6283}
6284
6285/*=================== operations with many arg.: static proc =================*/
6286/* must be ordered: first operations for chars (infix ops),
6287 * then alphabetically */
6288static BOOLEAN jjBREAK0(leftv res, leftv v)
6289{
6290#ifdef HAVE_SDB
6291  sdb_show_bp();
6292#endif
6293  return FALSE;
6294}
6295static BOOLEAN jjBREAK1(leftv res, leftv v)
6296{
6297#ifdef HAVE_SDB
6298  if(v->Typ()==PROC_CMD)
6299  {
6300    int lineno=0;
6301    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6302    {
6303      lineno=(int)(long)v->next->Data();
6304    }
6305    return sdb_set_breakpoint(v->Name(),lineno);
6306  }
6307  return TRUE;
6308#else
6309 return FALSE;
6310#endif
6311}
6312static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6313{
6314  return iiExprArith1(res,v,iiOp);
6315}
6316static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6317{
6318  leftv v=u->next;
6319  u->next=NULL;
6320  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6321  u->next=v;
6322  return b;
6323}
6324static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6325{
6326  leftv v = u->next;
6327  leftv w = v->next;
6328  u->next = NULL;
6329  v->next = NULL;
6330  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6331  u->next = v;
6332  v->next = w;
6333  return b;
6334}
6335
6336static BOOLEAN jjCOEF_M(leftv res, leftv v)
6337{
6338  if((v->Typ() != VECTOR_CMD)
6339  || (v->next->Typ() != POLY_CMD)
6340  || (v->next->next->Typ() != MATRIX_CMD)
6341  || (v->next->next->next->Typ() != MATRIX_CMD))
6342     return TRUE;
6343  if (v->next->next->rtyp!=IDHDL) return TRUE;
6344  idhdl c=(idhdl)v->next->next->data;
6345  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6346  idhdl m=(idhdl)v->next->next->next->data;
6347  idDelete((ideal *)&(c->data.uideal));
6348  idDelete((ideal *)&(m->data.uideal));
6349  mpCoef2((poly)v->Data(),(poly)v->next->Data(),
6350    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix));
6351  return FALSE;
6352}
6353
6354static BOOLEAN jjDIVISION4(leftv res, leftv v)
6355{ // may have 3 or 4 arguments
6356  leftv v1=v;
6357  leftv v2=v1->next;
6358  leftv v3=v2->next;
6359  leftv v4=v3->next;
6360  assumeStdFlag(v2);
6361
6362  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6363  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6364
6365  if((i1==0)||(i2==0)
6366  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6367  {
6368    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6369    return TRUE;
6370  }
6371
6372  sleftv w1,w2;
6373  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6374  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6375  ideal P=(ideal)w1.Data();
6376  ideal Q=(ideal)w2.Data();
6377
6378  int n=(int)(long)v3->Data();
6379  short *w=NULL;
6380  if(v4!=NULL)
6381  {
6382    w=iv2array((intvec *)v4->Data());
6383    short *w0=w+1;
6384    int i=pVariables;
6385    while(i>0&&*w0>0)
6386    {
6387      w0++;
6388      i--;
6389    }
6390    if(i>0)
6391      WarnS("not all weights are positive!");
6392  }
6393
6394  matrix T;
6395  ideal R;
6396  idLiftW(P,Q,n,T,R,w);
6397
6398  w1.CleanUp();
6399  w2.CleanUp();
6400  if(w!=NULL)
6401    omFree(w);
6402
6403  lists L=(lists) omAllocBin(slists_bin);
6404  L->Init(2);
6405  L->m[1].rtyp=v1->Typ();
6406  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6407  {
6408    if(v1->Typ()==POLY_CMD)
6409      p_Shift(&R->m[0],-1,currRing);
6410    L->m[1].data=(void *)R->m[0];
6411    R->m[0]=NULL;
6412    idDelete(&R);
6413  }
6414  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6415    L->m[1].data=(void *)idModule2Matrix(R);
6416  else
6417  {
6418    L->m[1].rtyp=MODUL_CMD;
6419    L->m[1].data=(void *)R;
6420  }
6421  L->m[0].rtyp=MATRIX_CMD;
6422  L->m[0].data=(char *)T;
6423
6424  res->data=L;
6425  res->rtyp=LIST_CMD;
6426
6427  return FALSE;
6428}
6429
6430//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6431//{
6432//  int l=u->listLength();
6433//  if (l<2) return TRUE;
6434//  BOOLEAN b;
6435//  leftv v=u->next;
6436//  leftv zz=v;
6437//  leftv z=zz;
6438//  u->next=NULL;
6439//  do
6440//  {
6441//    leftv z=z->next;
6442//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6443//    if (b) break;
6444//  } while (z!=NULL);
6445//  u->next=zz;
6446//  return b;
6447//}
6448static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6449{
6450  int s=1;
6451  leftv h=v;
6452  if (h!=NULL) s=exprlist_length(h);
6453  ideal id=idInit(s,1);
6454  int rank=1;
6455  int i=0;
6456  poly p;
6457  while (h!=NULL)
6458  {
6459    switch(h->Typ())
6460    {
6461      case POLY_CMD:
6462      {
6463        p=(poly)h->CopyD(POLY_CMD);
6464        break;
6465      }
6466      case INT_CMD:
6467      {
6468        number n=nInit((int)(long)h->Data());
6469        if (!nIsZero(n))
6470        {
6471          p=pNSet(n);
6472        }
6473        else
6474        {
6475          p=NULL;
6476          nDelete(&n);
6477        }
6478        break;
6479      }
6480      case BIGINT_CMD:
6481      {
6482        number b=(number)h->Data();
6483        number n=nInit_bigint(b);
6484        if (!nIsZero(n))
6485        {
6486          p=pNSet(n);
6487        }
6488        else
6489        {
6490          p=NULL;
6491          nDelete(&n);
6492        }
6493        break;
6494      }
6495      case NUMBER_CMD:
6496      {
6497        number n=(number)h->CopyD(NUMBER_CMD);
6498        if (!nIsZero(n))
6499        {
6500          p=pNSet(n);
6501        }
6502        else
6503        {
6504          p=NULL;
6505          nDelete(&n);
6506        }
6507        break;
6508      }
6509      case VECTOR_CMD:
6510      {
6511        p=(poly)h->CopyD(VECTOR_CMD);
6512        if (iiOp!=MODUL_CMD)
6513        {
6514          idDelete(&id);
6515          pDelete(&p);
6516          return TRUE;
6517        }
6518        rank=si_max(rank,(int)pMaxComp(p));
6519        break;
6520      }
6521      default:
6522      {
6523        idDelete(&id);
6524        return TRUE;
6525      }
6526    }
6527    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6528    {
6529      pSetCompP(p,1);
6530    }
6531    id->m[i]=p;
6532    i++;
6533    h=h->next;
6534  }
6535  id->rank=rank;
6536  res->data=(char *)id;
6537  return FALSE;
6538}
6539static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6540{
6541  leftv h=v;
6542  int l=v->listLength();
6543  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6544  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6545  int t=0;
6546  // try to convert to IDEAL_CMD
6547  while (h!=NULL)
6548  {
6549    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6550    {
6551      t=IDEAL_CMD;
6552    }
6553    else break;
6554    h=h->next;
6555  }
6556  // if failure, try MODUL_CMD
6557  if (t==0)
6558  {
6559    h=v;
6560    while (h!=NULL)
6561    {
6562      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6563      {
6564        t=MODUL_CMD;
6565      }
6566      else break;
6567      h=h->next;
6568    }
6569  }
6570  // check for success  in converting
6571  if (t==0)
6572  {
6573    WerrorS("cannot convert to ideal or module");
6574    return TRUE;
6575  }
6576  // call idMultSect
6577  h=v;
6578  int i=0;
6579  sleftv tmp;
6580  while (h!=NULL)
6581  {
6582    if (h->Typ()==t)
6583    {
6584      r[i]=(ideal)h->Data(); /*no copy*/
6585      h=h->next;
6586    }
6587    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6588    {
6589      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6590      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6591      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6592      return TRUE;
6593    }
6594    else
6595    {
6596      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6597      copied[i]=TRUE;
6598      h=tmp.next;
6599    }
6600    i++;
6601  }
6602  res->rtyp=t;
6603  res->data=(char *)idMultSect(r,i);
6604  while(i>0)
6605  {
6606    i--;
6607    if (copied[i]) idDelete(&(r[i]));
6608  }
6609  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6610  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6611  return FALSE;
6612}
6613static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6614{
6615  /* computation of the inverse of a quadratic matrix A
6616     using the L-U-decomposition of A;
6617     There are two valid parametrisations:
6618     1) exactly one argument which is just the matrix A,
6619     2) exactly three arguments P, L, U which already
6620        realise the L-U-decomposition of A, that is,
6621        P * A = L * U, and P, L, and U satisfy the
6622        properties decribed in method 'jjLU_DECOMP';
6623        see there;
6624     If A is invertible, the list [1, A^(-1)] is returned,
6625     otherwise the list [0] is returned. Thus, the user may
6626     inspect the first entry of the returned list to see
6627     whether A is invertible. */
6628  matrix iMat; int invertible;
6629  if (v->next == NULL)
6630  {
6631    if (v->Typ() != MATRIX_CMD)
6632    {
6633      Werror("expected either one or three matrices");
6634      return TRUE;
6635    }
6636    else
6637    {
6638      matrix aMat = (matrix)v->Data();
6639      int rr = aMat->rows();
6640      int cc = aMat->cols();
6641      if (rr != cc)
6642      {
6643        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6644        return TRUE;
6645      }
6646      invertible = luInverse(aMat, iMat);
6647    }
6648  }
6649  else if ((v->Typ() == MATRIX_CMD) &&
6650           (v->next->Typ() == MATRIX_CMD) &&
6651           (v->next->next != NULL) &&
6652           (v->next->next->Typ() == MATRIX_CMD) &&
6653           (v->next->next->next == NULL))
6654  {
6655     matrix pMat = (matrix)v->Data();
6656     matrix lMat = (matrix)v->next->Data();
6657     matrix uMat = (matrix)v->next->next->Data();
6658     int rr = uMat->rows();
6659     int cc = uMat->cols();
6660     if (rr != cc)
6661     {
6662       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6663              rr, cc);
6664       return TRUE;
6665     }
6666     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6667  }
6668  else
6669  {
6670    Werror("expected either one or three matrices");
6671    return TRUE;
6672  }
6673
6674  /* build the return structure; a list with either one or two entries */
6675  lists ll = (lists)omAllocBin(slists_bin);
6676  if (invertible)
6677  {
6678    ll->Init(2);
6679    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6680    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6681  }
6682  else
6683  {
6684    ll->Init(1);
6685    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6686  }
6687
6688  res->data=(char*)ll;
6689  return FALSE;
6690}
6691static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6692{
6693  /* for solving a linear equation system A * x = b, via the
6694     given LU-decomposition of the matrix A;
6695     There is one valid parametrisation:
6696     1) exactly four arguments P, L, U, b;
6697        P, L, and U realise the L-U-decomposition of A, that is,
6698        P * A = L * U, and P, L, and U satisfy the
6699        properties decribed in method 'jjLU_DECOMP';
6700        see there;
6701        b is the right-hand side vector of the equation system;
6702     The method will return a list of either 1 entry or three entries:
6703     1) [0] if there is no solution to the system;
6704     2) [1, x, H] if there is at least one solution;
6705        x is any solution of the given linear system,
6706        H is the matrix with column vectors spanning the homogeneous
6707        solution space.
6708     The method produces an error if matrix and vector sizes do not fit. */
6709  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
6710      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
6711      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
6712      (v->next->next->next == NULL) ||
6713      (v->next->next->next->Typ() != MATRIX_CMD) ||
6714      (v->next->next->next->next != NULL))
6715  {
6716    WerrorS("expected exactly three matrices and one vector as input");
6717    return TRUE;
6718  }
6719  matrix pMat = (matrix)v->Data();
6720  matrix lMat = (matrix)v->next->Data();
6721  matrix uMat = (matrix)v->next->next->Data();
6722  matrix bVec = (matrix)v->next->next->next->Data();
6723  matrix xVec; int solvable; matrix homogSolSpace;
6724  if (pMat->rows() != pMat->cols())
6725  {
6726    Werror("first matrix (%d x %d) is not quadratic",
6727           pMat->rows(), pMat->cols());
6728    return TRUE;
6729  }
6730  if (lMat->rows() != lMat->cols())
6731  {
6732    Werror("second matrix (%d x %d) is not quadratic",
6733           lMat->rows(), lMat->cols());
6734    return TRUE;
6735  }
6736  if (lMat->rows() != uMat->rows())
6737  {
6738    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
6739           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
6740    return TRUE;
6741  }
6742  if (uMat->rows() != bVec->rows())
6743  {
6744    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
6745           uMat->rows(), uMat->cols(), bVec->rows());
6746    return TRUE;
6747  }
6748  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
6749
6750  /* build the return structure; a list with either one or three entries */
6751  lists ll = (lists)omAllocBin(slists_bin);
6752  if (solvable)
6753  {
6754    ll->Init(3);
6755    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6756    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
6757    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
6758  }
6759  else
6760  {
6761    ll->Init(1);
6762    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6763  }
6764
6765  res->data=(char*)ll;
6766  return FALSE;
6767}
6768static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
6769{
6770  int i=0;
6771  leftv h=v;
6772  if (h!=NULL) i=exprlist_length(h);
6773  intvec *iv=new intvec(i);
6774  i=0;
6775  while (h!=NULL)
6776  {
6777    if(h->Typ()==INT_CMD)
6778    {
6779      (*iv)[i]=(int)(long)h->Data();
6780    }
6781    else
6782    {
6783      delete iv;
6784      return TRUE;
6785    }
6786    i++;
6787    h=h->next;
6788  }
6789  res->data=(char *)iv;
6790  return FALSE;
6791}
6792static BOOLEAN jjJET4(leftv res, leftv u)
6793{
6794  leftv u1=u;
6795  leftv u2=u1->next;
6796  leftv u3=u2->next;
6797  leftv u4=u3->next;
6798  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6799  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
6800  {
6801    if(!pIsUnit((poly)u2->Data()))
6802    {
6803      WerrorS("2nd argument must be a unit");
6804      return TRUE;
6805    }
6806    res->rtyp=u1->Typ();
6807    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
6808                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
6809    return FALSE;
6810  }
6811  else
6812  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6813  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
6814  {
6815    if(!mpIsDiagUnit((matrix)u2->Data()))
6816    {
6817      WerrorS("2nd argument must be a diagonal matrix of units");
6818      return TRUE;
6819    }
6820    res->rtyp=u1->Typ();
6821    res->data=(char*)idSeries((int)(long)u3->Data(),idCopy((ideal)u1->Data()),
6822                              mpCopy((matrix)u2->Data()),(intvec*)u4->Data());
6823    return FALSE;
6824  }
6825  else
6826  {
6827    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
6828           Tok2Cmdname(iiOp));
6829    return TRUE;
6830  }
6831}
6832static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
6833{
6834  if ((yyInRingConstruction)
6835  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
6836  {
6837    memcpy(res,u,sizeof(sleftv));
6838    memset(u,0,sizeof(sleftv));
6839    return FALSE;
6840  }
6841  leftv v=u->next;
6842  BOOLEAN b;
6843  if(v==NULL)
6844    b=iiExprArith1(res,u,iiOp);
6845  else
6846  {
6847    u->next=NULL;
6848    b=iiExprArith2(res,u,iiOp,v);
6849    u->next=v;
6850  }
6851  return b;
6852}
6853BOOLEAN jjLIST_PL(leftv res, leftv v)
6854{
6855  int sl=0;
6856  if (v!=NULL) sl = v->listLength();
6857  lists L;
6858  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
6859  {
6860    int add_row_shift = 0;
6861    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
6862    if (weights!=NULL)  add_row_shift=weights->min_in();
6863    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
6864  }
6865  else
6866  {
6867    L=(lists)omAllocBin(slists_bin);
6868    leftv h=NULL;
6869    int i;
6870    int rt;
6871
6872    L->Init(sl);
6873    for (i=0;i<sl;i++)
6874    {
6875      if (h!=NULL)
6876      { /* e.g. not in the first step:
6877         * h is the pointer to the old sleftv,
6878         * v is the pointer to the next sleftv
6879         * (in this moment) */
6880         h->next=v;
6881      }
6882      h=v;
6883      v=v->next;
6884      h->next=NULL;
6885      rt=h->Typ();
6886      if (rt==0)
6887      {
6888        L->Clean();
6889        Werror("`%s` is undefined",h->Fullname());
6890        return TRUE;
6891      }
6892      if ((rt==RING_CMD)||(rt==QRING_CMD))
6893      {
6894        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
6895        ((ring)L->m[i].data)->ref++;
6896      }
6897      else
6898        L->m[i].Copy(h);
6899    }
6900  }
6901  res->data=(char *)L;
6902  return FALSE;
6903}
6904static BOOLEAN jjNAMES0(leftv res, leftv v)
6905{
6906  res->data=(void *)ipNameList(IDROOT);
6907  return FALSE;
6908}
6909static BOOLEAN jjOPTION_PL(leftv res, leftv v)
6910{
6911  if(v==NULL)
6912  {
6913    res->data=(char *)showOption();
6914    return FALSE;
6915  }
6916  res->rtyp=NONE;
6917  return setOption(res,v);
6918}
6919static BOOLEAN jjREDUCE4(leftv res, leftv u)
6920{
6921  leftv u1=u;
6922  leftv u2=u1->next;
6923  leftv u3=u2->next;
6924  leftv u4=u3->next;
6925  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
6926  {
6927    int save_d=Kstd1_deg;
6928    Kstd1_deg=(int)(long)u3->Data();
6929    kModW=(intvec *)u4->Data();
6930    BITSET save=verbose;
6931    verbose|=Sy_bit(V_DEG_STOP);
6932    u2->next=NULL;
6933    BOOLEAN r=jjCALL2ARG(res,u);
6934    kModW=NULL;
6935    Kstd1_deg=save_d;
6936    verbose=save;
6937    u->next->next=u3;
6938    return r;
6939  }
6940  else
6941  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6942     (u4->Typ()==INT_CMD))
6943  {
6944    assumeStdFlag(u3);
6945    if(!mpIsDiagUnit((matrix)u2->Data()))
6946    {
6947      WerrorS("2nd argument must be a diagonal matrix of units");
6948      return TRUE;
6949    }
6950    res->rtyp=IDEAL_CMD;
6951    res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
6952                           mpCopy((matrix)u2->Data()),(int)(long)u4->Data());
6953    return FALSE;
6954  }
6955  else
6956  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6957     (u4->Typ()==INT_CMD))
6958  {
6959    assumeStdFlag(u3);
6960    if(!pIsUnit((poly)u2->Data()))
6961    {
6962      WerrorS("2nd argument must be a unit");
6963      return TRUE;
6964    }
6965    res->rtyp=POLY_CMD;
6966    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
6967                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
6968    return FALSE;
6969  }
6970  else
6971  {
6972    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
6973    return TRUE;
6974  }
6975}
6976static BOOLEAN jjREDUCE5(leftv res, leftv u)
6977{
6978  leftv u1=u;
6979  leftv u2=u1->next;
6980  leftv u3=u2->next;
6981  leftv u4=u3->next;
6982  leftv u5=u4->next;
6983  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6984     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
6985  {
6986    assumeStdFlag(u3);
6987    if(!mpIsDiagUnit((matrix)u2->Data()))
6988    {
6989      WerrorS("2nd argument must be a diagonal matrix of units");
6990      return TRUE;
6991    }
6992    res->rtyp=IDEAL_CMD;
6993    res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
6994                           mpCopy((matrix)u2->Data()),
6995                           (int)(long)u4->Data(),(intvec*)u5->Data());
6996    return FALSE;
6997  }
6998  else
6999  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7000     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7001  {
7002    assumeStdFlag(u3);
7003    if(!pIsUnit((poly)u2->Data()))
7004    {
7005      WerrorS("2nd argument must be a unit");
7006      return TRUE;
7007    }
7008    res->rtyp=POLY_CMD;
7009    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7010                           pCopy((poly)u2->Data()),
7011                           (int)(long)u4->Data(),(intvec*)u5->Data());
7012    return FALSE;
7013  }
7014  else
7015  {
7016    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7017           Tok2Cmdname(iiOp));
7018    return TRUE;
7019  }
7020}
7021static BOOLEAN jjRESERVED0(leftv res, leftv v)
7022{
7023  int i=1;
7024  int nCount = (sArithBase.nCmdUsed-1)/3;
7025  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7026  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7027  //      sArithBase.nCmdAllocated);
7028  for(i=0; i<nCount; i++)
7029  {
7030    Print("%-20s",sArithBase.sCmds[i+1].name);
7031    if(i+1+nCount<sArithBase.nCmdUsed)
7032      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7033    if(i+1+2*nCount<sArithBase.nCmdUsed)
7034      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7035    //if ((i%3)==1) PrintLn();
7036    PrintLn();
7037  }
7038  PrintLn();
7039  printBlackboxTypes();
7040  return FALSE;
7041}
7042static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7043{
7044  if (v == NULL)
7045  {
7046    res->data = omStrDup("");
7047    return FALSE;
7048  }
7049  int n = v->listLength();
7050  if (n == 1)
7051  {
7052    res->data = v->String();
7053    return FALSE;
7054  }
7055
7056  char** slist = (char**) omAlloc(n*sizeof(char*));
7057  int i, j;
7058
7059  for (i=0, j=0; i<n; i++, v = v ->next)
7060  {
7061    slist[i] = v->String();
7062    assume(slist[i] != NULL);
7063    j+=strlen(slist[i]);
7064  }
7065  char* s = (char*) omAlloc((j+1)*sizeof(char));
7066  *s='\0';
7067  for (i=0;i<n;i++)
7068  {
7069    strcat(s, slist[i]);
7070    omFree(slist[i]);
7071  }
7072  omFreeSize(slist, n*sizeof(char*));
7073  res->data = s;
7074  return FALSE;
7075}
7076static BOOLEAN jjTEST(leftv res, leftv v)
7077{
7078  do
7079  {
7080    if (v->Typ()!=INT_CMD)
7081      return TRUE;
7082    test_cmd((int)(long)v->Data());
7083    v=v->next;
7084  }
7085  while (v!=NULL);
7086  return FALSE;
7087}
7088
7089#if defined(__alpha) && !defined(linux)
7090extern "C"
7091{
7092  void usleep(unsigned long usec);
7093};
7094#endif
7095static BOOLEAN jjFactModD_M(leftv res, leftv v)
7096{
7097  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7098     see a detailed documentation in /kernel/linearAlgebra.h
7099
7100     valid argument lists:
7101     - (poly h, int d),
7102     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7103     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7104                                                          in list of ring vars,
7105     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7106                                                optional: all 4 optional args
7107     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7108      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7109      has exactly two distinct monic factors [possibly with exponent > 1].)
7110     result:
7111     - list with the two factors f and g such that
7112       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7113
7114  poly h      = NULL;
7115  int  d      =    1;
7116  poly f0     = NULL;
7117  poly g0     = NULL;
7118  int  xIndex =    1;   /* default index if none provided */
7119  int  yIndex =    2;   /* default index if none provided */
7120
7121  leftv u = v; int factorsGiven = 0;
7122  if ((u == NULL) || (u->Typ() != POLY_CMD))
7123  {
7124    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7125    return TRUE;
7126  }
7127  else h = (poly)u->Data();
7128  u = u->next;
7129  if ((u == NULL) || (u->Typ() != INT_CMD))
7130  {
7131    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7132    return TRUE;
7133  }
7134  else d = (int)(long)u->Data();
7135  u = u->next;
7136  if ((u != NULL) && (u->Typ() == POLY_CMD))
7137  {
7138    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7139    {
7140      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7141      return TRUE;
7142    }
7143    else
7144    {
7145      f0 = (poly)u->Data();
7146      g0 = (poly)u->next->Data();
7147      factorsGiven = 1;
7148      u = u->next->next;
7149    }
7150  }
7151  if ((u != NULL) && (u->Typ() == INT_CMD))
7152  {
7153    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7154    {
7155      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7156      return TRUE;
7157    }
7158    else
7159    {
7160      xIndex = (int)(long)u->Data();
7161      yIndex = (int)(long)u->next->Data();
7162      u = u->next->next;
7163    }
7164  }
7165  if (u != NULL)
7166  {
7167    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7168    return TRUE;
7169  }
7170
7171  /* checks for provided arguments */
7172  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7173  {
7174    WerrorS("expected non-constant polynomial argument(s)");
7175    return TRUE;
7176  }
7177  int n = rVar(currRing);
7178  if ((xIndex < 1) || (n < xIndex))
7179  {
7180    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7181    return TRUE;
7182  }
7183  if ((yIndex < 1) || (n < yIndex))
7184  {
7185    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7186    return TRUE;
7187  }
7188  if (xIndex == yIndex)
7189  {
7190    WerrorS("expected distinct indices for variables x and y");
7191    return TRUE;
7192  }
7193
7194  /* computation of f0 and g0 if missing */
7195  if (factorsGiven == 0)
7196  {
7197#ifdef HAVE_FACTORY
7198    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7199    intvec* v = NULL;
7200    ideal i = singclap_factorize(h0, &v, 0);
7201
7202    ivTest(v);
7203
7204    if (i == NULL) return TRUE;
7205
7206    idTest(i);
7207
7208    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7209    {
7210      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7211      return TRUE;
7212    }
7213    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7214    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7215    idDelete(&i);
7216#else
7217    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7218    return TRUE;
7219#endif
7220  }
7221
7222  poly f; poly g;
7223  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7224  lists L = (lists)omAllocBin(slists_bin);
7225  L->Init(2);
7226  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7227  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7228  res->rtyp = LIST_CMD;
7229  res->data = (char*)L;
7230  return FALSE;
7231}
7232static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7233{
7234  if ((v->Typ() != LINK_CMD) ||
7235      (v->next->Typ() != STRING_CMD) ||
7236      (v->next->next->Typ() != STRING_CMD) ||
7237      (v->next->next->next->Typ() != INT_CMD))
7238    return TRUE;
7239  jjSTATUS3(res, v, v->next, v->next->next);
7240#if defined(HAVE_USLEEP)
7241  if (((long) res->data) == 0L)
7242  {
7243    int i_s = (int)(long) v->next->next->next->Data();
7244    if (i_s > 0)
7245    {
7246      usleep((int)(long) v->next->next->next->Data());
7247      jjSTATUS3(res, v, v->next, v->next->next);
7248    }
7249  }
7250#elif defined(HAVE_SLEEP)
7251  if (((int) res->data) == 0)
7252  {
7253    int i_s = (int) v->next->next->next->Data();
7254    if (i_s > 0)
7255    {
7256      sleep((is - 1)/1000000 + 1);
7257      jjSTATUS3(res, v, v->next, v->next->next);
7258    }
7259  }
7260#endif
7261  return FALSE;
7262}
7263static BOOLEAN jjSUBST_M(leftv res, leftv u)
7264{
7265  leftv v = u->next; // number of args > 0
7266  if (v==NULL) return TRUE;
7267  leftv w = v->next;
7268  if (w==NULL) return TRUE;
7269  leftv rest = w->next;;
7270
7271  u->next = NULL;
7272  v->next = NULL;
7273  w->next = NULL;
7274  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7275  if ((rest!=NULL) && (!b))
7276  {
7277    sleftv tmp_res;
7278    leftv tmp_next=res->next;
7279    res->next=rest;
7280    memset(&tmp_res,0,sizeof(tmp_res));
7281    b = iiExprArithM(&tmp_res,res,iiOp);
7282    memcpy(res,&tmp_res,sizeof(tmp_res));
7283    res->next=tmp_next;
7284  }
7285  u->next = v;
7286  v->next = w;
7287  // rest was w->next, but is already cleaned
7288  return b;
7289}
7290static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7291{
7292  if ((INPUT->Typ() != MATRIX_CMD) ||
7293      (INPUT->next->Typ() != NUMBER_CMD) ||
7294      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7295      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7296  {
7297    WerrorS("expected (matrix, number, number, number) as arguments");
7298    return TRUE;
7299  }
7300  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7301  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7302                                    (number)(v->Data()),
7303                                    (number)(w->Data()),
7304                                    (number)(x->Data()));
7305  return FALSE;
7306}
7307static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7308{ ideal result;
7309  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7310  leftv v = u->next;  /* one additional polynomial or ideal */
7311  leftv h = v->next;  /* Hilbert vector */
7312  leftv w = h->next;  /* weight vector */
7313  assumeStdFlag(u);
7314  ideal i1=(ideal)(u->Data());
7315  ideal i0;
7316  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7317  || (h->Typ()!=INTVEC_CMD)
7318  || (w->Typ()!=INTVEC_CMD))
7319  {
7320    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7321    return TRUE;
7322  }
7323  intvec *vw=(intvec *)w->Data(); // weights of vars
7324  /* merging std_hilb_w and std_1 */
7325  if (vw->length()!=currRing->N)
7326  {
7327    Werror("%d weights for %d variables",vw->length(),currRing->N);
7328    return TRUE;
7329  }
7330  int r=v->Typ();
7331  BOOLEAN cleanup_i0=FALSE;
7332  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7333  {
7334    i0=idInit(1,i1->rank);
7335    i0->m[0]=(poly)v->Data();
7336    BOOLEAN cleanup_i0=TRUE;
7337  }
7338  else if (r==IDEAL_CMD)/* IDEAL */
7339  {
7340    i0=(ideal)v->Data();
7341  }
7342  else
7343  {
7344    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7345    return TRUE;
7346  }
7347  int ii0=idElem(i0);
7348  i1 = idSimpleAdd(i1,i0);
7349  if (cleanup_i0)
7350  {
7351    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7352    idDelete(&i0);
7353  }
7354  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7355  tHomog hom=testHomog;
7356  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7357  if (ww!=NULL)
7358  {
7359    if (!idTestHomModule(i1,currQuotient,ww))
7360    {
7361      WarnS("wrong weights");
7362      ww=NULL;
7363    }
7364    else
7365    {
7366      ww=ivCopy(ww);
7367      hom=isHomog;
7368    }
7369  }
7370  BITSET save_test=test;
7371  test|=Sy_bit(OPT_SB_1);
7372  result=kStd(i1,
7373              currQuotient,
7374              hom,
7375              &ww,                  // module weights
7376              (intvec *)h->Data(),  // hilbert series
7377              0,                    // syzComp, whatever it is...
7378              IDELEMS(i1)-ii0,      // new ideal
7379              vw);                  // weights of vars
7380  test=save_test;
7381  idDelete(&i1);
7382  idSkipZeroes(result);
7383  res->data = (char *)result;
7384  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7385  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7386  return FALSE;
7387}
7388
7389
7390#ifdef MDEBUG
7391static Subexpr jjDBMakeSub(leftv e,const char *f,const int l)
7392#else
7393static Subexpr jjMakeSub(leftv e)
7394#endif
7395{
7396  assume( e->Typ()==INT_CMD );
7397  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7398  r->start =(int)(long)e->Data();
7399  return r;
7400}
7401#define D(A) (A)
7402#define IPARITH
7403#include "table.h"
7404
7405#include <iparith.inc>
7406
7407/*=================== operations with 2 args. ============================*/
7408/* must be ordered: first operations for chars (infix ops),
7409 * then alphabetically */
7410
7411BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7412{
7413  memset(res,0,sizeof(sleftv));
7414  BOOLEAN call_failed=FALSE;
7415
7416  if (!errorreported)
7417  {
7418#ifdef SIQ
7419    if (siq>0)
7420    {
7421      //Print("siq:%d\n",siq);
7422      command d=(command)omAlloc0Bin(sip_command_bin);
7423      memcpy(&d->arg1,a,sizeof(sleftv));
7424      //a->Init();
7425      memcpy(&d->arg2,b,sizeof(sleftv));
7426      //b->Init();
7427      d->argc=2;
7428      d->op=op;
7429      res->data=(char *)d;
7430      res->rtyp=COMMAND;
7431      return FALSE;
7432    }
7433#endif
7434    int at=a->Typ();
7435    if (at>MAX_TOK)
7436    {
7437      blackbox *bb=getBlackboxStuff(at);
7438      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7439      else          return TRUE;
7440    }
7441    int bt=b->Typ();
7442    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7443    int index=i;
7444
7445    iiOp=op;
7446    while (dArith2[i].cmd==op)
7447    {
7448      if ((at==dArith2[i].arg1)
7449      && (bt==dArith2[i].arg2))
7450      {
7451        res->rtyp=dArith2[i].res;
7452        if (currRing!=NULL)
7453        {
7454          if (check_valid(dArith2[i].valid_for,op)) break;
7455        }
7456        if (TEST_V_ALLWARN)
7457          Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt));
7458        if ((call_failed=dArith2[i].p(res,a,b)))
7459        {
7460          break;// leave loop, goto error handling
7461        }
7462        a->CleanUp();
7463        b->CleanUp();
7464        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7465        return FALSE;
7466      }
7467      i++;
7468    }
7469    // implicite type conversion ----------------------------------------------
7470    if (dArith2[i].cmd!=op)
7471    {
7472      int ai,bi;
7473      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7474      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7475      BOOLEAN failed=FALSE;
7476      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7477      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7478      while (dArith2[i].cmd==op)
7479      {
7480        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7481        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7482        {
7483          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7484          {
7485            res->rtyp=dArith2[i].res;
7486            if (currRing!=NULL)
7487            {
7488              if (check_valid(dArith2[i].valid_for,op)) break;
7489            }
7490            if (TEST_V_ALLWARN)
7491              Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),
7492              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7493            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7494            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7495            || (call_failed=dArith2[i].p(res,an,bn)));
7496            // everything done, clean up temp. variables
7497            if (failed)
7498            {
7499              // leave loop, goto error handling
7500              break;
7501            }
7502            else
7503            {
7504              // everything ok, clean up and return
7505              an->CleanUp();
7506              bn->CleanUp();
7507              omFreeBin((ADDRESS)an, sleftv_bin);
7508              omFreeBin((ADDRESS)bn, sleftv_bin);
7509              a->CleanUp();
7510              b->CleanUp();
7511              return FALSE;
7512            }
7513          }
7514        }
7515        i++;
7516      }
7517      an->CleanUp();
7518      bn->CleanUp();
7519      omFreeBin((ADDRESS)an, sleftv_bin);
7520      omFreeBin((ADDRESS)bn, sleftv_bin);
7521    }
7522    // error handling ---------------------------------------------------
7523    const char *s=NULL;
7524    if (!errorreported)
7525    {
7526      if ((at==0) && (a->Fullname()!=sNoName))
7527      {
7528        s=a->Fullname();
7529      }
7530      else if ((bt==0) && (b->Fullname()!=sNoName))
7531      {
7532        s=b->Fullname();
7533      }
7534      if (s!=NULL)
7535        Werror("`%s` is not defined",s);
7536      else
7537      {
7538        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7539        s = iiTwoOps(op);
7540        if (proccall)
7541        {
7542          Werror("%s(`%s`,`%s`) failed"
7543                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7544        }
7545        else
7546        {
7547          Werror("`%s` %s `%s` failed"
7548                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7549        }
7550        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7551        {
7552          while (dArith2[i].cmd==op)
7553          {
7554            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7555            && (dArith2[i].res!=0)
7556            && (dArith2[i].p!=jjWRONG2))
7557            {
7558              if (proccall)
7559                Werror("expected %s(`%s`,`%s`)"
7560                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7561              else
7562                Werror("expected `%s` %s `%s`"
7563                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7564            }
7565            i++;
7566          }
7567        }
7568      }
7569    }
7570    res->rtyp = UNKNOWN;
7571  }
7572  a->CleanUp();
7573  b->CleanUp();
7574  return TRUE;
7575}
7576
7577/*==================== operations with 1 arg. ===============================*/
7578/* must be ordered: first operations for chars (infix ops),
7579 * then alphabetically */
7580
7581BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7582{
7583  memset(res,0,sizeof(sleftv));
7584  BOOLEAN call_failed=FALSE;
7585
7586  if (!errorreported)
7587  {
7588#ifdef SIQ
7589    if (siq>0)
7590    {
7591      //Print("siq:%d\n",siq);
7592      command d=(command)omAlloc0Bin(sip_command_bin);
7593      memcpy(&d->arg1,a,sizeof(sleftv));
7594      //a->Init();
7595      d->op=op;
7596      d->argc=1;
7597      res->data=(char *)d;
7598      res->rtyp=COMMAND;
7599      return FALSE;
7600    }
7601#endif
7602    int at=a->Typ();
7603    if (at>MAX_TOK)
7604    {
7605      blackbox *bb=getBlackboxStuff(at);
7606      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7607      else          return TRUE;
7608    }
7609
7610    BOOLEAN failed=FALSE;
7611    iiOp=op;
7612    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7613    int ti = i;
7614    while (dArith1[i].cmd==op)
7615    {
7616      if (at==dArith1[i].arg)
7617      {
7618        int r=res->rtyp=dArith1[i].res;
7619        if (currRing!=NULL)
7620        {
7621          if (check_valid(dArith1[i].valid_for,op)) break;
7622        }
7623        if (TEST_V_ALLWARN)
7624          Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at));
7625        if (r<0)
7626        {
7627          res->rtyp=-r;
7628          #ifdef PROC_BUG
7629          dArith1[i].p(res,a);
7630          #else
7631          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7632          #endif
7633        }
7634        else if ((call_failed=dArith1[i].p(res,a)))
7635        {
7636          break;// leave loop, goto error handling
7637        }
7638        if (a->Next()!=NULL)
7639        {
7640          res->next=(leftv)omAllocBin(sleftv_bin);
7641          failed=iiExprArith1(res->next,a->next,op);
7642        }
7643        a->CleanUp();
7644        return failed;
7645      }
7646      i++;
7647    }
7648    // implicite type conversion --------------------------------------------
7649    if (dArith1[i].cmd!=op)
7650    {
7651      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7652      i=ti;
7653      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7654      while (dArith1[i].cmd==op)
7655      {
7656        int ai;
7657        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7658        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7659        {
7660          int r=res->rtyp=dArith1[i].res;
7661          if (currRing!=NULL)
7662          {
7663            if (check_valid(dArith1[i].valid_for,op)) break;
7664          }
7665          if (r<0)
7666          {
7667            res->rtyp=-r;
7668            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7669            if (!failed)
7670            {
7671              #ifdef PROC_BUG
7672              dArith1[i].p(res,a);
7673              #else
7674              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
7675              #endif
7676            }
7677          }
7678          else
7679          {
7680            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
7681            || (call_failed=dArith1[i].p(res,an)));
7682          }
7683          // everything done, clean up temp. variables
7684          if (failed)
7685          {
7686            // leave loop, goto error handling
7687            break;
7688          }
7689          else
7690          {
7691            if (TEST_V_ALLWARN)
7692              Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp));
7693            if (an->Next() != NULL)
7694            {
7695              res->next = (leftv)omAllocBin(sleftv_bin);
7696              failed=iiExprArith1(res->next,an->next,op);
7697            }
7698            // everything ok, clean up and return
7699            an->CleanUp();
7700            omFreeBin((ADDRESS)an, sleftv_bin);
7701            a->CleanUp();
7702            return failed;
7703          }
7704        }
7705        i++;
7706      }
7707      an->CleanUp();
7708      omFreeBin((ADDRESS)an, sleftv_bin);
7709    }
7710    // error handling
7711    if (!errorreported)
7712    {
7713      if ((at==0) && (a->Fullname()!=sNoName))
7714      {
7715        Werror("`%s` is not defined",a->Fullname());
7716      }
7717      else
7718      {
7719        i=ti;
7720        const char *s = iiTwoOps(op);
7721        Werror("%s(`%s`) failed"
7722                ,s,Tok2Cmdname(at));
7723        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7724        {
7725          while (dArith1[i].cmd==op)
7726          {
7727            if ((dArith1[i].res!=0)
7728            && (dArith1[i].p!=jjWRONG))
7729              Werror("expected %s(`%s`)"
7730                ,s,Tok2Cmdname(dArith1[i].arg));
7731            i++;
7732          }
7733        }
7734      }
7735    }
7736    res->rtyp = UNKNOWN;
7737  }
7738  a->CleanUp();
7739  return TRUE;
7740}
7741
7742/*=================== operations with 3 args. ============================*/
7743/* must be ordered: first operations for chars (infix ops),
7744 * then alphabetically */
7745
7746BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
7747{
7748  memset(res,0,sizeof(sleftv));
7749  BOOLEAN call_failed=FALSE;
7750
7751  if (!errorreported)
7752  {
7753#ifdef SIQ
7754    if (siq>0)
7755    {
7756      //Print("siq:%d\n",siq);
7757      command d=(command)omAlloc0Bin(sip_command_bin);
7758      memcpy(&d->arg1,a,sizeof(sleftv));
7759      //a->Init();
7760      memcpy(&d->arg2,b,sizeof(sleftv));
7761      //b->Init();
7762      memcpy(&d->arg3,c,sizeof(sleftv));
7763      //c->Init();
7764      d->op=op;
7765      d->argc=3;
7766      res->data=(char *)d;
7767      res->rtyp=COMMAND;
7768      return FALSE;
7769    }
7770#endif
7771    int at=a->Typ();
7772    if (at>MAX_TOK)
7773    {
7774      blackbox *bb=getBlackboxStuff(at);
7775      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
7776      else          return TRUE;
7777    }
7778    int bt=b->Typ();
7779    int ct=c->Typ();
7780
7781    iiOp=op;
7782    int i=0;
7783    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7784    while (dArith3[i].cmd==op)
7785    {
7786      if ((at==dArith3[i].arg1)
7787      && (bt==dArith3[i].arg2)
7788      && (ct==dArith3[i].arg3))
7789      {
7790        res->rtyp=dArith3[i].res;
7791        if (currRing!=NULL)
7792        {
7793          if (check_valid(dArith3[i].valid_for,op)) break;
7794        }
7795        if (TEST_V_ALLWARN)
7796          Print("call %s(%s,%s,%s)\n",
7797            Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7798        if ((call_failed=dArith3[i].p(res,a,b,c)))
7799        {
7800          break;// leave loop, goto error handling
7801        }
7802        a->CleanUp();
7803        b->CleanUp();
7804        c->CleanUp();
7805        return FALSE;
7806      }
7807      i++;
7808    }
7809    // implicite type conversion ----------------------------------------------
7810    if (dArith3[i].cmd!=op)
7811    {
7812      int ai,bi,ci;
7813      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7814      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7815      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
7816      BOOLEAN failed=FALSE;
7817      i=0;
7818      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7819      while (dArith3[i].cmd==op)
7820      {
7821        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
7822        {
7823          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
7824          {
7825            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
7826            {
7827              res->rtyp=dArith3[i].res;
7828              if (currRing!=NULL)
7829              {
7830                if (check_valid(dArith3[i].valid_for,op)) break;
7831              }
7832              if (TEST_V_ALLWARN)
7833                Print("call %s(%s,%s,%s)\n",
7834                  Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp),
7835                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
7836              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
7837                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
7838                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
7839                || (call_failed=dArith3[i].p(res,an,bn,cn)));
7840              // everything done, clean up temp. variables
7841              if (failed)
7842              {
7843                // leave loop, goto error handling
7844                break;
7845              }
7846              else
7847              {
7848                // everything ok, clean up and return
7849                an->CleanUp();
7850                bn->CleanUp();
7851                cn->CleanUp();
7852                omFreeBin((ADDRESS)an, sleftv_bin);
7853                omFreeBin((ADDRESS)bn, sleftv_bin);
7854                omFreeBin((ADDRESS)cn, sleftv_bin);
7855                a->CleanUp();
7856                b->CleanUp();
7857                c->CleanUp();
7858        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7859                return FALSE;
7860              }
7861            }
7862          }
7863        }
7864        i++;
7865      }
7866      an->CleanUp();
7867      bn->CleanUp();
7868      cn->CleanUp();
7869      omFreeBin((ADDRESS)an, sleftv_bin);
7870      omFreeBin((ADDRESS)bn, sleftv_bin);
7871      omFreeBin((ADDRESS)cn, sleftv_bin);
7872    }
7873    // error handling ---------------------------------------------------
7874    if (!errorreported)
7875    {
7876      const char *s=NULL;
7877      if ((at==0) && (a->Fullname()!=sNoName))
7878      {
7879        s=a->Fullname();
7880      }
7881      else if ((bt==0) && (b->Fullname()!=sNoName))
7882      {
7883        s=b->Fullname();
7884      }
7885      else if ((ct==0) && (c->Fullname()!=sNoName))
7886      {
7887        s=c->Fullname();
7888      }
7889      if (s!=NULL)
7890        Werror("`%s` is not defined",s);
7891      else
7892      {
7893        i=0;
7894        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7895        const char *s = iiTwoOps(op);
7896        Werror("%s(`%s`,`%s`,`%s`) failed"
7897                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7898        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7899        {
7900          while (dArith3[i].cmd==op)
7901          {
7902            if(((at==dArith3[i].arg1)
7903            ||(bt==dArith3[i].arg2)
7904            ||(ct==dArith3[i].arg3))
7905            && (dArith3[i].res!=0))
7906            {
7907              Werror("expected %s(`%s`,`%s`,`%s`)"
7908                  ,s,Tok2Cmdname(dArith3[i].arg1)
7909                  ,Tok2Cmdname(dArith3[i].arg2)
7910                  ,Tok2Cmdname(dArith3[i].arg3));
7911            }
7912            i++;
7913          }
7914        }
7915      }
7916    }
7917    res->rtyp = UNKNOWN;
7918  }
7919  a->CleanUp();
7920  b->CleanUp();
7921  c->CleanUp();
7922        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7923  return TRUE;
7924}
7925/*==================== operations with many arg. ===============================*/
7926/* must be ordered: first operations for chars (infix ops),
7927 * then alphabetically */
7928
7929BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
7930{
7931  // cnt = 0: all
7932  // cnt = 1: only first one
7933  leftv next;
7934  BOOLEAN failed = TRUE;
7935  if(v==NULL) return failed;
7936  res->rtyp = LIST_CMD;
7937  if(cnt) v->next = NULL;
7938  next = v->next;             // saving next-pointer
7939  failed = jjLIST_PL(res, v);
7940  v->next = next;             // writeback next-pointer
7941  return failed;
7942}
7943
7944BOOLEAN iiExprArithM(leftv res, leftv a, int op)
7945{
7946  memset(res,0,sizeof(sleftv));
7947
7948  if (!errorreported)
7949  {
7950#ifdef SIQ
7951    if (siq>0)
7952    {
7953      //Print("siq:%d\n",siq);
7954      command d=(command)omAlloc0Bin(sip_command_bin);
7955      d->op=op;
7956      res->data=(char *)d;
7957      if (a!=NULL)
7958      {
7959        d->argc=a->listLength();
7960        // else : d->argc=0;
7961        memcpy(&d->arg1,a,sizeof(sleftv));
7962        switch(d->argc)
7963        {
7964          case 3:
7965            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
7966            a->next->next->Init();
7967            /* no break */
7968          case 2:
7969            memcpy(&d->arg2,a->next,sizeof(sleftv));
7970            a->next->Init();
7971            a->next->next=d->arg2.next;
7972            d->arg2.next=NULL;
7973            /* no break */
7974          case 1:
7975            a->Init();
7976            a->next=d->arg1.next;
7977            d->arg1.next=NULL;
7978        }
7979        if (d->argc>3) a->next=NULL;
7980        a->name=NULL;
7981        a->rtyp=0;
7982        a->data=NULL;
7983        a->e=NULL;
7984        a->attribute=NULL;
7985        a->CleanUp();
7986      }
7987      res->rtyp=COMMAND;
7988      return FALSE;
7989    }
7990#endif
7991    if ((a!=NULL) && (a->Typ()>MAX_TOK))
7992    {
7993      blackbox *bb=getBlackboxStuff(a->Typ());
7994      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
7995      else          return TRUE;
7996    }
7997    BOOLEAN failed=FALSE;
7998    int args=0;
7999    if (a!=NULL) args=a->listLength();
8000
8001    iiOp=op;
8002    int i=0;
8003    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8004    while (dArithM[i].cmd==op)
8005    {
8006      if ((args==dArithM[i].number_of_args)
8007      || (dArithM[i].number_of_args==-1)
8008      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8009      {
8010        res->rtyp=dArithM[i].res;
8011        if (currRing!=NULL)
8012        {
8013          if (check_valid(dArithM[i].valid_for,op)) break;
8014        }
8015        if (TEST_V_ALLWARN)
8016          Print("call %s(... (%d args))\n", Tok2Cmdname(iiOp),args);
8017        if (dArithM[i].p(res,a))
8018        {
8019          break;// leave loop, goto error handling
8020        }
8021        if (a!=NULL) a->CleanUp();
8022        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8023        return failed;
8024      }
8025      i++;
8026    }
8027    // error handling
8028    if (!errorreported)
8029    {
8030      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8031      {
8032        Werror("`%s` is not defined",a->Fullname());
8033      }
8034      else
8035      {
8036        const char *s = iiTwoOps(op);
8037        Werror("%s(...) failed",s);
8038      }
8039    }
8040    res->rtyp = UNKNOWN;
8041  }
8042  if (a!=NULL) a->CleanUp();
8043        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8044  return TRUE;
8045}
8046
8047/*=================== general utilities ============================*/
8048int IsCmd(const char *n, int & tok)
8049{
8050  int i;
8051  int an=1;
8052  int en=sArithBase.nLastIdentifier;
8053
8054  loop
8055  //for(an=0; an<sArithBase.nCmdUsed; )
8056  {
8057    if(an>=en-1)
8058    {
8059      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8060      {
8061        i=an;
8062        break;
8063      }
8064      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8065      {
8066        i=en;
8067        break;
8068      }
8069      else
8070      {
8071        // -- blackbox extensions:
8072        // return 0;
8073        return blackboxIsCmd(n,tok);
8074      }
8075    }
8076    i=(an+en)/2;
8077    if (*n < *(sArithBase.sCmds[i].name))
8078    {
8079      en=i-1;
8080    }
8081    else if (*n > *(sArithBase.sCmds[i].name))
8082    {
8083      an=i+1;
8084    }
8085    else
8086    {
8087      int v=strcmp(n,sArithBase.sCmds[i].name);
8088      if(v<0)
8089      {
8090        en=i-1;
8091      }
8092      else if(v>0)
8093      {
8094        an=i+1;
8095      }
8096      else /*v==0*/
8097      {
8098        break;
8099      }
8100    }
8101  }
8102  lastreserved=sArithBase.sCmds[i].name;
8103  tok=sArithBase.sCmds[i].tokval;
8104  if(sArithBase.sCmds[i].alias==2)
8105  {
8106    Warn("outdated identifier `%s` used - please change your code",
8107    sArithBase.sCmds[i].name);
8108    sArithBase.sCmds[i].alias=1;
8109  }
8110  if (currRingHdl==NULL)
8111  {
8112    #ifdef SIQ
8113    if (siq<=0)
8114    {
8115    #endif
8116      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8117      {
8118        WerrorS("no ring active");
8119        return 0;
8120      }
8121    #ifdef SIQ
8122    }
8123    #endif
8124  }
8125  if (!expected_parms)
8126  {
8127    switch (tok)
8128    {
8129      case IDEAL_CMD:
8130      case INT_CMD:
8131      case INTVEC_CMD:
8132      case MAP_CMD:
8133      case MATRIX_CMD:
8134      case MODUL_CMD:
8135      case POLY_CMD:
8136      case PROC_CMD:
8137      case RING_CMD:
8138      case STRING_CMD:
8139        cmdtok = tok;
8140        break;
8141    }
8142  }
8143  return sArithBase.sCmds[i].toktype;
8144}
8145static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8146{
8147  int a=0;
8148  int e=len;
8149  int p=len/2;
8150  do
8151  {
8152     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8153     if (op<dArithTab[p].cmd) e=p-1;
8154     else   a = p+1;
8155     p=a+(e-a)/2;
8156  }
8157  while ( a <= e);
8158
8159  assume(0);
8160  return 0;
8161}
8162
8163const char * Tok2Cmdname(int tok)
8164{
8165  int i = 0;
8166  if (tok <= 0)
8167  {
8168    return sArithBase.sCmds[0].name;
8169  }
8170  if (tok==ANY_TYPE) return "any_type";
8171  if (tok==COMMAND) return "command";
8172  if (tok==NONE) return "nothing";
8173  //if (tok==IFBREAK) return "if_break";
8174  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8175  //if (tok==ORDER_VECTOR) return "ordering";
8176  //if (tok==REF_VAR) return "ref";
8177  //if (tok==OBJECT) return "object";
8178  //if (tok==PRINT_EXPR) return "print_expr";
8179  if (tok==IDHDL) return "identifier";
8180  if (tok>MAX_TOK) return getBlackboxName(tok);
8181  for(i=0; i<sArithBase.nCmdUsed; i++)
8182    //while (sArithBase.sCmds[i].tokval!=0)
8183  {
8184    if ((sArithBase.sCmds[i].tokval == tok)&&
8185        (sArithBase.sCmds[i].alias==0))
8186    {
8187      return sArithBase.sCmds[i].name;
8188    }
8189  }
8190  return sArithBase.sCmds[0].name;
8191}
8192
8193
8194/*---------------------------------------------------------------------*/
8195/**
8196 * @brief compares to entry of cmdsname-list
8197
8198 @param[in] a
8199 @param[in] b
8200
8201 @return <ReturnValue>
8202**/
8203/*---------------------------------------------------------------------*/
8204static int _gentable_sort_cmds( const void *a, const void *b )
8205{
8206  cmdnames *pCmdL = (cmdnames*)a;
8207  cmdnames *pCmdR = (cmdnames*)b;
8208
8209  if(a==NULL || b==NULL)             return 0;
8210
8211  /* empty entries goes to the end of the list for later reuse */
8212  if(pCmdL->name==NULL) return 1;
8213  if(pCmdR->name==NULL) return -1;
8214
8215  /* $INVALID$ must come first */
8216  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8217  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8218
8219  /* tokval=-1 are reserved names at the end */
8220  if (pCmdL->tokval==-1)
8221  {
8222    if (pCmdR->tokval==-1)
8223       return strcmp(pCmdL->name, pCmdR->name);
8224    /* pCmdL->tokval==-1, pCmdL goes at the end */
8225    return 1;
8226  }
8227  /* pCmdR->tokval==-1, pCmdR goes at the end */
8228  if(pCmdR->tokval==-1) return -1;
8229
8230  return strcmp(pCmdL->name, pCmdR->name);
8231}
8232
8233/*---------------------------------------------------------------------*/
8234/**
8235 * @brief initialisation of arithmetic structured data
8236
8237 @retval 0 on success
8238
8239**/
8240/*---------------------------------------------------------------------*/
8241int iiInitArithmetic()
8242{
8243  int i;
8244  //printf("iiInitArithmetic()\n");
8245  memset(&sArithBase, 0, sizeof(sArithBase));
8246  iiInitCmdName();
8247  /* fix last-identifier */
8248#if 0
8249  /* we expect that gentable allready did every thing */
8250  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8251      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8252    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8253  }
8254#endif
8255  //Print("L=%d\n", sArithBase.nLastIdentifier);
8256
8257  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8258  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8259
8260  //iiArithAddCmd("Top", 0,-1,0);
8261
8262
8263  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8264  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8265  //         sArithBase.sCmds[i].name,
8266  //         sArithBase.sCmds[i].alias,
8267  //         sArithBase.sCmds[i].tokval,
8268  //         sArithBase.sCmds[i].toktype);
8269  //}
8270  //iiArithRemoveCmd("Top");
8271  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8272  //iiArithRemoveCmd("mygcd");
8273  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8274  return 0;
8275}
8276
8277/*---------------------------------------------------------------------*/
8278/**
8279 * @brief append newitem of size sizeofitem to the list named list.
8280
8281 @param[in,out] list
8282 @param[in,out] item_count
8283 @param[in] sizeofitem
8284 @param[in] newitem
8285
8286 @retval  0 success
8287 @retval -1 failure
8288**/
8289/*---------------------------------------------------------------------*/
8290int iiArithAddItem2list(
8291  void **list,
8292  long  *item_count,
8293  long sizeofitem,
8294  void *newitem
8295  )
8296{
8297  int count = *item_count;
8298
8299  //TRACE(0, "add_item_to_list(%p, %p, %ld, %p)\n", list, item_count,
8300  //       sizeofitem, newitem);
8301
8302  if(count==0)
8303  {
8304    *list = (void *)omAlloc(sizeofitem);
8305  }
8306  else
8307  {
8308    *list = (void *)omRealloc(*list, (count+1) * sizeofitem);
8309  }
8310  if((*list)==NULL) return -1;
8311
8312  //memset((*list)+count*sizeofitem, 0, sizeofitem);
8313  //memcpy((*list)+count*sizeofitem, newitem, sizeofitem);
8314
8315  /* erhoehe counter um 1 */
8316  (count)++;
8317  *item_count = count;
8318  return 0;
8319}
8320
8321int iiArithFindCmd(const char *szName)
8322{
8323  int an=0;
8324  int i = 0,v = 0;
8325  int en=sArithBase.nLastIdentifier;
8326
8327  loop
8328  //for(an=0; an<sArithBase.nCmdUsed; )
8329  {
8330    if(an>=en-1)
8331    {
8332      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8333      {
8334        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8335        return an;
8336      }
8337      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8338      {
8339        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8340        return en;
8341      }
8342      else
8343      {
8344        //Print("RET- 1\n");
8345        return -1;
8346      }
8347    }
8348    i=(an+en)/2;
8349    if (*szName < *(sArithBase.sCmds[i].name))
8350    {
8351      en=i-1;
8352    }
8353    else if (*szName > *(sArithBase.sCmds[i].name))
8354    {
8355      an=i+1;
8356    }
8357    else
8358    {
8359      v=strcmp(szName,sArithBase.sCmds[i].name);
8360      if(v<0)
8361      {
8362        en=i-1;
8363      }
8364      else if(v>0)
8365      {
8366        an=i+1;
8367      }
8368      else /*v==0*/
8369      {
8370        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8371        return i;
8372      }
8373    }
8374  }
8375  //if(i>=0 && i<sArithBase.nCmdUsed)
8376  //  return i;
8377  //Print("RET-2\n");
8378  return -2;
8379}
8380
8381char *iiArithGetCmd( int nPos )
8382{
8383  if(nPos<0) return NULL;
8384  if(nPos<sArithBase.nCmdUsed)
8385    return sArithBase.sCmds[nPos].name;
8386  return NULL;
8387}
8388
8389int iiArithRemoveCmd(const char *szName)
8390{
8391  int nIndex;
8392  if(szName==NULL) return -1;
8393
8394  nIndex = iiArithFindCmd(szName);
8395  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8396  {
8397    Print("'%s' not found (%d)\n", szName, nIndex);
8398    return -1;
8399  }
8400  omFree(sArithBase.sCmds[nIndex].name);
8401  sArithBase.sCmds[nIndex].name=NULL;
8402  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8403        (&_gentable_sort_cmds));
8404  sArithBase.nCmdUsed--;
8405
8406  /* fix last-identifier */
8407  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8408      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8409  {
8410    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8411  }
8412  //Print("L=%d\n", sArithBase.nLastIdentifier);
8413  return 0;
8414}
8415
8416int iiArithAddCmd(
8417  const char *szName,
8418  short nAlias,
8419  short nTokval,
8420  short nToktype,
8421  short nPos
8422  )
8423{
8424  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8425  //       nTokval, nToktype, nPos);
8426  if(nPos>=0)
8427  {
8428    // no checks: we rely on a correct generated code in iparith.inc
8429    assume(nPos < sArithBase.nCmdAllocated);
8430    assume(szName!=NULL);
8431    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8432    sArithBase.sCmds[nPos].alias   = nAlias;
8433    sArithBase.sCmds[nPos].tokval  = nTokval;
8434    sArithBase.sCmds[nPos].toktype = nToktype;
8435    sArithBase.nCmdUsed++;
8436    //if(nTokval>0) sArithBase.nLastIdentifier++;
8437  }
8438  else
8439  {
8440    if(szName==NULL) return -1;
8441    int nIndex = iiArithFindCmd(szName);
8442    if(nIndex>=0)
8443    {
8444      Print("'%s' already exists at %d\n", szName, nIndex);
8445      return -1;
8446    }
8447
8448    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8449    {
8450      /* needs to create new slots */
8451      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8452      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8453      if(sArithBase.sCmds==NULL) return -1;
8454      sArithBase.nCmdAllocated++;
8455    }
8456    /* still free slots available */
8457    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8458    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8459    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8460    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8461    sArithBase.nCmdUsed++;
8462
8463    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8464          (&_gentable_sort_cmds));
8465    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8466        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8467    {
8468      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8469    }
8470    //Print("L=%d\n", sArithBase.nLastIdentifier);
8471  }
8472  return 0;
8473}
8474
8475static BOOLEAN check_valid(const int p, const int op)
8476{
8477  #ifdef HAVE_PLURAL
8478  if (rIsPluralRing(currRing))
8479  {
8480    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8481    {
8482      WerrorS("not implemented for non-commutative rings");
8483      return TRUE;
8484    }
8485    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8486    {
8487      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8488      return FALSE;
8489    }
8490    /* else, ALLOW_PLURAL */
8491  }
8492  #endif
8493  #ifdef HAVE_RINGS
8494  if (rField_is_Ring(currRing))
8495  {
8496    if ((p & RING_MASK)==0 /*NO_RING*/)
8497    {
8498      WerrorS("not implemented for rings with rings as coeffients");
8499      return TRUE;
8500    }
8501    /* else ALLOW_RING */
8502    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8503    &&(!rField_is_Domain(currRing)))
8504    {
8505      WerrorS("domain required as coeffients");
8506      return TRUE;
8507    }
8508    /* else ALLOW_ZERODIVISOR */
8509  }
8510  #endif
8511  return FALSE;
8512}
Note: See TracBrowser for help on using the repository browser.