source: git/Singular/iparith.cc @ e75eab

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