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

spielwiese
Last change on this file since 3dbee61 was 3dbee61, checked in by Hans Schoenemann <hannes@…>, 13 years ago
merging SINGULAR-algnumbers: longalg rev 13634 git-svn-id: file:///usr/local/Singular/svn/trunk@14399 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 206.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: table driven kernel interface, used by interpreter
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <ctype.h>
13#include <stdio.h>
14#include <time.h>
15#include <unistd.h>
16
17#include <kernel/mod2.h>
18#include <Singular/tok.h>
19#include <kernel/options.h>
20#include <Singular/ipid.h>
21#include <kernel/intvec.h>
22#include <omalloc/omalloc.h>
23#include <kernel/polys.h>
24#include <kernel/febase.h>
25#include <Singular/sdb.h>
26#include <kernel/longalg.h>
27#include <kernel/longtrans.h>
28#include <kernel/ideals.h>
29#include <kernel/prCopy.h>
30#include <kernel/matpol.h>
31#include <kernel/kstd1.h>
32#include <kernel/timer.h>
33#include <kernel/ring.h>
34#include <Singular/subexpr.h>
35#include <Singular/lists.h>
36#include <kernel/modulop.h>
37#ifdef HAVE_RINGS
38#include <kernel/rmodulon.h>
39#include <kernel/rmodulo2m.h>
40#include <kernel/rintegers.h>
41#endif
42#include <kernel/numbers.h>
43#include <kernel/stairc.h>
44#include <kernel/maps.h>
45#include <Singular/maps_ip.h>
46#include <kernel/syz.h>
47#include <kernel/weight.h>
48#include <Singular/ipconv.h>
49#include <Singular/ipprint.h>
50#include <Singular/attrib.h>
51#include <Singular/silink.h>
52#include <kernel/sparsmat.h>
53#include <kernel/units.h>
54#include <Singular/janet.h>
55#include <kernel/GMPrat.h>
56#include <kernel/tgb.h>
57#include <kernel/walkProc.h>
58#include <kernel/mod_raw.h>
59#include <Singular/MinorInterface.h>
60#include <kernel/linearAlgebra.h>
61#include <Singular/misc_ip.h>
62#ifdef HAVE_FACTORY
63#  include <kernel/clapsing.h>
64#  include <kernel/kstdfac.h>
65#endif /* HAVE_FACTORY */
66#ifdef HAVE_FACTORY
67#  include <kernel/fglm.h>
68#endif /* HAVE_FACTORY */
69#include <Singular/interpolation.h>
70
71#include <Singular/blackbox.h>
72#include <Singular/newstruct.h>
73#include <Singular/ipshell.h>
74#include <kernel/mpr_inout.h>
75
76#include <kernel/timer.h>
77
78// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
79
80#ifdef HAVE_PLURAL
81  #include <kernel/gring.h>
82  #include <kernel/sca.h>
83  #define ALLOW_PLURAL     1
84  #define NO_PLURAL        0
85  #define COMM_PLURAL      2
86  #define  PLURAL_MASK 3
87#else /* HAVE_PLURAL */
88  #define ALLOW_PLURAL     0
89  #define NO_PLURAL        0
90  #define COMM_PLURAL      0
91  #define  PLURAL_MASK     0
92#endif /* HAVE_PLURAL */
93
94#ifdef HAVE_RINGS
95  #define RING_MASK        4
96  #define ZERODIVISOR_MASK 8
97#else
98  #define RING_MASK        0
99  #define ZERODIVISOR_MASK 0
100#endif
101#define ALLOW_RING       4
102#define NO_RING          0
103#define NO_ZERODIVISOR   8
104#define ALLOW_ZERODIVISOR  0
105
106static BOOLEAN check_valid(const int p, const int op);
107
108/*=============== types =====================*/
109struct sValCmdTab
110{
111  short cmd;
112  short start;
113};
114
115typedef sValCmdTab jjValCmdTab[];
116
117struct _scmdnames
118{
119  char *name;
120  short alias;
121  short tokval;
122  short toktype;
123};
124typedef struct _scmdnames cmdnames;
125
126
127typedef char * (*Proc1)(char *);
128struct sValCmd1
129{
130  proc1 p;
131  short cmd;
132  short res;
133  short arg;
134  short valid_for;
135};
136
137typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
138struct sValCmd2
139{
140  proc2 p;
141  short cmd;
142  short res;
143  short arg1;
144  short arg2;
145  short valid_for;
146};
147
148typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
149struct sValCmd3
150{
151  proc3 p;
152  short cmd;
153  short res;
154  short arg1;
155  short arg2;
156  short arg3;
157  short valid_for;
158};
159struct sValCmdM
160{
161  proc1 p;
162  short cmd;
163  short res;
164  short number_of_args; /* -1: any, -2: any >0, .. */
165  short valid_for;
166};
167
168typedef struct
169{
170  cmdnames *sCmds;             /**< array of existing commands */
171  struct sValCmd1 *psValCmd1;
172  struct sValCmd2 *psValCmd2;
173  struct sValCmd3 *psValCmd3;
174  struct sValCmdM *psValCmdM;
175  int nCmdUsed;      /**< number of commands used */
176  int nCmdAllocated; /**< number of commands-slots allocated */
177  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
178} SArithBase;
179
180/*---------------------------------------------------------------------*
181 * File scope Variables (Variables share by several functions in
182 *                       the same file )
183 *
184 *---------------------------------------------------------------------*/
185static SArithBase sArithBase;  /**< Base entry for arithmetic */
186
187/*---------------------------------------------------------------------*
188 * Extern Functions declarations
189 *
190 *---------------------------------------------------------------------*/
191static int _gentable_sort_cmds(const void *a, const void *b);
192extern int iiArithRemoveCmd(char *szName);
193extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
194                         short nToktype, short nPos=-1);
195
196/*============= proc =======================*/
197static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
198static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
199#ifdef MDEBUG
200#define jjMakeSub(A) jjDBMakeSub(A,__FILE__,__LINE__)
201static Subexpr jjDBMakeSub(leftv e,const char *f,const  int l);
202#else
203static Subexpr jjMakeSub(leftv e);
204#endif
205
206/*============= vars ======================*/
207extern int cmdtok;
208extern BOOLEAN expected_parms;
209
210#define ii_div_by_0 "div. by 0"
211
212int iiOp; /* the current operation*/
213
214/*=================== operations with 2 args.: static proc =================*/
215/* must be ordered: first operations for chars (infix ops),
216 * then alphabetically */
217
218static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
219{
220  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
221  int bb = (int)(long)(v->Data());
222  if (errorreported) return TRUE;
223  switch (iiOp)
224  {
225    case '+': (*aa) += bb; break;
226    case '-': (*aa) -= bb; break;
227    case '*': (*aa) *= bb; break;
228    case '/':
229    case INTDIV_CMD: (*aa) /= bb; break;
230    case '%':
231    case INTMOD_CMD: (*aa) %= bb; break;
232  }
233  res->data=(char *)aa;
234  return FALSE;
235}
236static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
237{
238  return jjOP_IV_I(res,v,u);
239}
240static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
241{
242  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
243  int bb = (int)(long)(v->Data());
244  int i=si_min(aa->rows(),aa->cols());
245  switch (iiOp)
246  {
247    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
248              break;
249    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
250              break;
251  }
252  res->data=(char *)aa;
253  return FALSE;
254}
255static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
256{
257  return jjOP_IM_I(res,v,u);
258}
259static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
260{
261  int l=(int)(long)v->Data();
262  if (l>0)
263  {
264    int d=(int)(long)u->Data();
265    intvec *vv=new intvec(l);
266    int i;
267    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
268    res->data=(char *)vv;
269  }
270  return (l<=0);
271}
272static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
273{
274  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
275  return FALSE;
276}
277static void jjEQUAL_REST(leftv res,leftv u,leftv v);
278static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
279{
280  intvec*    a = (intvec * )(u->Data());
281  intvec*    b = (intvec * )(v->Data());
282  int r=a->compare(b);
283  switch  (iiOp)
284  {
285    case '<':
286      res->data  = (char *) (r<0);
287      break;
288    case '>':
289      res->data  = (char *) (r>0);
290      break;
291    case LE:
292      res->data  = (char *) (r<=0);
293      break;
294    case GE:
295      res->data  = (char *) (r>=0);
296      break;
297    case EQUAL_EQUAL:
298    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
299      res->data  = (char *) (r==0);
300      break;
301  }
302  jjEQUAL_REST(res,u,v);
303  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
304  return FALSE;
305}
306static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
307{
308  intvec* a = (intvec * )(u->Data());
309  int     b = (int)(long)(v->Data());
310  int r=a->compare(b);
311  switch  (iiOp)
312  {
313    case '<':
314      res->data  = (char *) (r<0);
315      break;
316    case '>':
317      res->data  = (char *) (r>0);
318      break;
319    case LE:
320      res->data  = (char *) (r<=0);
321      break;
322    case GE:
323      res->data  = (char *) (r>=0);
324      break;
325    case EQUAL_EQUAL:
326    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
327      res->data  = (char *) (r==0);
328      break;
329  }
330  jjEQUAL_REST(res,u,v);
331  return FALSE;
332}
333static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
334{
335  poly p=(poly)u->Data();
336  poly q=(poly)v->Data();
337  int r=pCmp(p,q);
338  if (r==0)
339  {
340    number h=nSub(pGetCoeff(p),pGetCoeff(q));
341    /* compare lead coeffs */
342    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
343    nDelete(&h);
344  }
345  else if (p==NULL)
346  {
347    if (q==NULL)
348    {
349      /* compare 0, 0 */
350      r=0;
351    }
352    else if(pIsConstant(q))
353    {
354      /* compare 0, const */
355      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
356    }
357  }
358  else if (q==NULL)
359  {
360    if (pIsConstant(p))
361    {
362      /* compare const, 0 */
363      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
364    }
365  }
366  switch  (iiOp)
367  {
368    case '<':
369      res->data  = (char *) (r < 0);
370      break;
371    case '>':
372      res->data  = (char *) (r > 0);
373      break;
374    case LE:
375      res->data  = (char *) (r <= 0);
376      break;
377    case GE:
378      res->data  = (char *) (r >= 0);
379      break;
380    //case EQUAL_EQUAL:
381    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
382    //  res->data  = (char *) (r == 0);
383    //  break;
384  }
385  jjEQUAL_REST(res,u,v);
386  return FALSE;
387}
388static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
389{
390  char*    a = (char * )(u->Data());
391  char*    b = (char * )(v->Data());
392  int result = strcmp(a,b);
393  switch  (iiOp)
394  {
395    case '<':
396      res->data  = (char *) (result  < 0);
397      break;
398    case '>':
399      res->data  = (char *) (result  > 0);
400      break;
401    case LE:
402      res->data  = (char *) (result  <= 0);
403      break;
404    case GE:
405      res->data  = (char *) (result  >= 0);
406      break;
407    case EQUAL_EQUAL:
408    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
409      res->data  = (char *) (result  == 0);
410      break;
411  }
412  jjEQUAL_REST(res,u,v);
413  return FALSE;
414}
415static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
416{
417  if (u->Next()!=NULL)
418  {
419    u=u->next;
420    res->next = (leftv)omAllocBin(sleftv_bin);
421    return iiExprArith2(res->next,u,iiOp,v);
422  }
423  else if (v->Next()!=NULL)
424  {
425    v=v->next;
426    res->next = (leftv)omAllocBin(sleftv_bin);
427    return iiExprArith2(res->next,u,iiOp,v);
428  }
429  return FALSE;
430}
431static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
432{
433  int b=(int)(long)u->Data();
434  int e=(int)(long)v->Data();
435  int rc = 1;
436  BOOLEAN overflow=FALSE;
437  if (e >= 0)
438  {
439    if (b==0)
440    {
441      rc=(e==0);
442    }
443    else
444    {
445      int oldrc;
446      while ((e--)!=0)
447      {
448        oldrc=rc;
449        rc *= b;
450        if (!overflow)
451        {
452          if(rc/b!=oldrc) overflow=TRUE;
453        }
454      }
455      if (overflow)
456        WarnS("int overflow(^), result may be wrong");
457    }
458    res->data = (char *)((long)rc);
459    if (u!=NULL) return jjOP_REST(res,u,v);
460    return FALSE;
461  }
462  else
463  {
464    WerrorS("exponent must be non-negative");
465    return TRUE;
466  }
467}
468static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
469{
470  int e=(int)(long)v->Data();
471  number n=(number)u->Data();
472  if (e>=0)
473  {
474    nlPower(n,e,(number*)&res->data);
475  }
476  else
477  {
478    WerrorS("exponent must be non-negative");
479    return TRUE;
480  }
481  if (u!=NULL) return jjOP_REST(res,u,v);
482  return FALSE;
483}
484static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
485{
486  int e=(int)(long)v->Data();
487  number n=(number)u->Data();
488  int d=0;
489  if (e<0)
490  {
491    n=nInvers(n);
492    e=-e;
493    d=1;
494  }
495  nPower(n,e,(number*)&res->data);
496  if (d) nDelete(&n);
497  if (u!=NULL) return jjOP_REST(res,u,v);
498  return FALSE;
499}
500static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
501{
502  int v_i=(int)(long)v->Data();
503  if (v_i<0)
504  {
505    WerrorS("exponent must be non-negative");
506    return TRUE;
507  }
508  poly u_p=(poly)u->CopyD(POLY_CMD);
509  int dummy;
510  if ((u_p!=NULL)
511  && ((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 naSetChar(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 jjidMinBase    (proc1)idMinBase
5122#define jjsyMinBase    (proc1)syMinBase
5123#define jjpMaxComp     (proc1)pMaxCompProc
5124#define jjmpTrace      (proc1)mpTrace
5125#define jjmpTransp     (proc1)mpTransp
5126#define jjrOrdStr      (proc1)rOrdStr
5127#define jjrVarStr      (proc1)rVarStr
5128#define jjrParStr      (proc1)rParStr
5129#define jjCOUNT_RES    (proc1)sySize
5130#define jjDIM_R        (proc1)syDim
5131#define jjidTransp     (proc1)idTransp
5132#endif
5133#endif
5134static BOOLEAN jjnInt(leftv res, leftv u)
5135{
5136  number n=(number)u->Data();
5137  res->data=(char *)(long)n_Int(n,currRing);
5138  return FALSE;
5139}
5140static BOOLEAN jjnlInt(leftv res, leftv u)
5141{
5142  number n=(number)u->Data();
5143  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
5144  return FALSE;
5145}
5146/*=================== operations with 3 args.: static proc =================*/
5147/* must be ordered: first operations for chars (infix ops),
5148 * then alphabetically */
5149static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5150{
5151  char *s= (char *)u->Data();
5152  int   r = (int)(long)v->Data();
5153  int   c = (int)(long)w->Data();
5154  int l = strlen(s);
5155
5156  if ( (r<1) || (r>l) || (c<0) )
5157  {
5158    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5159    return TRUE;
5160  }
5161  res->data = (char *)omAlloc((long)(c+1));
5162  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5163  return FALSE;
5164}
5165static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5166{
5167  intvec *iv = (intvec *)u->Data();
5168  int   r = (int)(long)v->Data();
5169  int   c = (int)(long)w->Data();
5170  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5171  {
5172    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5173           r,c,u->Fullname(),iv->rows(),iv->cols());
5174    return TRUE;
5175  }
5176  res->data=u->data; u->data=NULL;
5177  res->rtyp=u->rtyp; u->rtyp=0;
5178  res->name=u->name; u->name=NULL;
5179  Subexpr e=jjMakeSub(v);
5180          e->next=jjMakeSub(w);
5181  if (u->e==NULL) res->e=e;
5182  else
5183  {
5184    Subexpr h=u->e;
5185    while (h->next!=NULL) h=h->next;
5186    h->next=e;
5187    res->e=u->e;
5188    u->e=NULL;
5189  }
5190  return FALSE;
5191}
5192static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5193{
5194  matrix m= (matrix)u->Data();
5195  int   r = (int)(long)v->Data();
5196  int   c = (int)(long)w->Data();
5197  //Print("gen. elem %d, %d\n",r,c);
5198  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5199  {
5200    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5201      MATROWS(m),MATCOLS(m));
5202    return TRUE;
5203  }
5204  res->data=u->data; u->data=NULL;
5205  res->rtyp=u->rtyp; u->rtyp=0;
5206  res->name=u->name; u->name=NULL;
5207  Subexpr e=jjMakeSub(v);
5208          e->next=jjMakeSub(w);
5209  if (u->e==NULL)
5210    res->e=e;
5211  else
5212  {
5213    Subexpr h=u->e;
5214    while (h->next!=NULL) h=h->next;
5215    h->next=e;
5216    res->e=u->e;
5217    u->e=NULL;
5218  }
5219  return FALSE;
5220}
5221static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5222{
5223  sleftv t;
5224  sleftv ut;
5225  leftv p=NULL;
5226  intvec *iv=(intvec *)w->Data();
5227  int l;
5228  BOOLEAN nok;
5229
5230  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5231  {
5232    WerrorS("cannot build expression lists from unnamed objects");
5233    return TRUE;
5234  }
5235  memcpy(&ut,u,sizeof(ut));
5236  memset(&t,0,sizeof(t));
5237  t.rtyp=INT_CMD;
5238  for (l=0;l< iv->length(); l++)
5239  {
5240    t.data=(char *)(long)((*iv)[l]);
5241    if (p==NULL)
5242    {
5243      p=res;
5244    }
5245    else
5246    {
5247      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5248      p=p->next;
5249    }
5250    memcpy(u,&ut,sizeof(ut));
5251    if (u->Typ() == MATRIX_CMD)
5252      nok=jjBRACK_Ma(p,u,v,&t);
5253    else /* INTMAT_CMD */
5254      nok=jjBRACK_Im(p,u,v,&t);
5255    if (nok)
5256    {
5257      while (res->next!=NULL)
5258      {
5259        p=res->next->next;
5260        omFreeBin((ADDRESS)res->next, sleftv_bin);
5261        // res->e aufraeumen !!!!
5262        res->next=p;
5263      }
5264      return TRUE;
5265    }
5266  }
5267  return FALSE;
5268}
5269static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5270{
5271  sleftv t;
5272  sleftv ut;
5273  leftv p=NULL;
5274  intvec *iv=(intvec *)v->Data();
5275  int l;
5276  BOOLEAN nok;
5277
5278  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5279  {
5280    WerrorS("cannot build expression lists from unnamed objects");
5281    return TRUE;
5282  }
5283  memcpy(&ut,u,sizeof(ut));
5284  memset(&t,0,sizeof(t));
5285  t.rtyp=INT_CMD;
5286  for (l=0;l< iv->length(); l++)
5287  {
5288    t.data=(char *)(long)((*iv)[l]);
5289    if (p==NULL)
5290    {
5291      p=res;
5292    }
5293    else
5294    {
5295      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5296      p=p->next;
5297    }
5298    memcpy(u,&ut,sizeof(ut));
5299    if (u->Typ() == MATRIX_CMD)
5300      nok=jjBRACK_Ma(p,u,&t,w);
5301    else /* INTMAT_CMD */
5302      nok=jjBRACK_Im(p,u,&t,w);
5303    if (nok)
5304    {
5305      while (res->next!=NULL)
5306      {
5307        p=res->next->next;
5308        omFreeBin((ADDRESS)res->next, sleftv_bin);
5309        // res->e aufraeumen !!
5310        res->next=p;
5311      }
5312      return TRUE;
5313    }
5314  }
5315  return FALSE;
5316}
5317static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5318{
5319  sleftv t1,t2,ut;
5320  leftv p=NULL;
5321  intvec *vv=(intvec *)v->Data();
5322  intvec *wv=(intvec *)w->Data();
5323  int vl;
5324  int wl;
5325  BOOLEAN nok;
5326
5327  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5328  {
5329    WerrorS("cannot build expression lists from unnamed objects");
5330    return TRUE;
5331  }
5332  memcpy(&ut,u,sizeof(ut));
5333  memset(&t1,0,sizeof(sleftv));
5334  memset(&t2,0,sizeof(sleftv));
5335  t1.rtyp=INT_CMD;
5336  t2.rtyp=INT_CMD;
5337  for (vl=0;vl< vv->length(); vl++)
5338  {
5339    t1.data=(char *)(long)((*vv)[vl]);
5340    for (wl=0;wl< wv->length(); wl++)
5341    {
5342      t2.data=(char *)(long)((*wv)[wl]);
5343      if (p==NULL)
5344      {
5345        p=res;
5346      }
5347      else
5348      {
5349        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5350        p=p->next;
5351      }
5352      memcpy(u,&ut,sizeof(ut));
5353      if (u->Typ() == MATRIX_CMD)
5354        nok=jjBRACK_Ma(p,u,&t1,&t2);
5355      else /* INTMAT_CMD */
5356        nok=jjBRACK_Im(p,u,&t1,&t2);
5357      if (nok)
5358      {
5359        res->CleanUp();
5360        return TRUE;
5361      }
5362    }
5363  }
5364  return FALSE;
5365}
5366static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5367{
5368  v->next=(leftv)omAllocBin(sleftv_bin);
5369  memcpy(v->next,w,sizeof(sleftv));
5370  memset(w,0,sizeof(sleftv));
5371  return jjPROC(res,u,v);
5372}
5373static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5374{
5375  u->next=(leftv)omAllocBin(sleftv_bin);
5376  memcpy(u->next,v,sizeof(sleftv));
5377  u->next->next=(leftv)omAllocBin(sleftv_bin);
5378  memcpy(u->next->next,w,sizeof(sleftv));
5379  BOOLEAN r=iiExprArithM(res,u,iiOp);
5380  v->Init();
5381  w->Init();
5382  //w->rtyp=0; w->data=NULL;
5383  // iiExprArithM did the CleanUp
5384  return r;
5385}
5386static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5387{
5388  intvec *iv;
5389  ideal m;
5390  lists l=(lists)omAllocBin(slists_bin);
5391  int k=(int)(long)w->Data();
5392  if (k>=0)
5393  {
5394    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5395    l->Init(2);
5396    l->m[0].rtyp=MODUL_CMD;
5397    l->m[1].rtyp=INTVEC_CMD;
5398    l->m[0].data=(void *)m;
5399    l->m[1].data=(void *)iv;
5400  }
5401  else
5402  {
5403    m=smCallSolv((ideal)u->Data());
5404    l->Init(1);
5405    l->m[0].rtyp=IDEAL_CMD;
5406    l->m[0].data=(void *)m;
5407  }
5408  res->data = (char *)l;
5409  return FALSE;
5410}
5411static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5412{
5413  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5414  {
5415    WerrorS("3rd argument must be a name of a matrix");
5416    return TRUE;
5417  }
5418  ideal i=(ideal)u->Data();
5419  int rank=(int)i->rank;
5420  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5421  if (r) return TRUE;
5422  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5423  return FALSE;
5424}
5425static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5426{
5427  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5428           (ideal)(v->Data()),(poly)(w->Data()));
5429  return FALSE;
5430}
5431static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5432{
5433  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5434  {
5435    WerrorS("3rd argument must be a name of a matrix");
5436    return TRUE;
5437  }
5438  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5439  poly p=(poly)u->CopyD(POLY_CMD);
5440  ideal i=idInit(1,1);
5441  i->m[0]=p;
5442  sleftv t;
5443  memset(&t,0,sizeof(t));
5444  t.data=(char *)i;
5445  t.rtyp=IDEAL_CMD;
5446  int rank=1;
5447  if (u->Typ()==VECTOR_CMD)
5448  {
5449    i->rank=rank=pMaxComp(p);
5450    t.rtyp=MODUL_CMD;
5451  }
5452  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5453  t.CleanUp();
5454  if (r) return TRUE;
5455  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5456  return FALSE;
5457}
5458static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5459{
5460  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5461    (intvec *)w->Data());
5462  //setFlag(res,FLAG_STD);
5463  return FALSE;
5464}
5465static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5466{
5467  /*4
5468  * look for the substring what in the string where
5469  * starting at position n
5470  * return the position of the first char of what in where
5471  * or 0
5472  */
5473  int n=(int)(long)w->Data();
5474  char *where=(char *)u->Data();
5475  char *what=(char *)v->Data();
5476  char *found;
5477  if ((1>n)||(n>(int)strlen(where)))
5478  {
5479    Werror("start position %d out of range",n);
5480    return TRUE;
5481  }
5482  found = strchr(where+n-1,*what);
5483  if (*(what+1)!='\0')
5484  {
5485    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5486    {
5487      found=strchr(found+1,*what);
5488    }
5489  }
5490  if (found != NULL)
5491  {
5492    res->data=(char *)((found-where)+1);
5493  }
5494  return FALSE;
5495}
5496static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5497{
5498  if ((int)(long)w->Data()==0)
5499    res->data=(char *)walkProc(u,v);
5500  else
5501    res->data=(char *)fractalWalkProc(u,v);
5502  setFlag( res, FLAG_STD );
5503  return FALSE;
5504}
5505static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5506{
5507  intvec *wdegree=(intvec*)w->Data();
5508  if (wdegree->length()!=pVariables)
5509  {
5510    Werror("weight vector must have size %d, not %d",
5511           pVariables,wdegree->length());
5512    return TRUE;
5513  }
5514#ifdef HAVE_RINGS
5515  if (rField_is_Ring_Z(currRing))
5516  {
5517    ring origR = currRing;
5518    ring tempR = rCopy(origR);
5519    tempR->ringtype = 0; tempR->ch = 0;
5520    rComplete(tempR);
5521    ideal uid = (ideal)u->Data();
5522    rChangeCurrRing(tempR);
5523    ideal uu = idrCopyR(uid, origR, currRing);
5524    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5525    uuAsLeftv.rtyp = IDEAL_CMD;
5526    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5527    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5528    assumeStdFlag(&uuAsLeftv);
5529    Print("// NOTE: computation of Hilbert series etc. is being\n");
5530    Print("//       performed for generic fibre, that is, over Q\n");
5531    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5532    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5533    int returnWithTrue = 1;
5534    switch((int)(long)v->Data())
5535    {
5536      case 1:
5537        res->data=(void *)iv;
5538        returnWithTrue = 0;
5539      case 2:
5540        res->data=(void *)hSecondSeries(iv);
5541        delete iv;
5542        returnWithTrue = 0;
5543    }
5544    if (returnWithTrue)
5545    {
5546      WerrorS(feNotImplemented);
5547      delete iv;
5548    }
5549    idDelete(&uu);
5550    rChangeCurrRing(origR);
5551    rDelete(tempR);
5552    if (returnWithTrue) return TRUE; else return FALSE;
5553  }
5554#endif
5555  assumeStdFlag(u);
5556  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5557  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5558  switch((int)(long)v->Data())
5559  {
5560    case 1:
5561      res->data=(void *)iv;
5562      return FALSE;
5563    case 2:
5564      res->data=(void *)hSecondSeries(iv);
5565      delete iv;
5566      return FALSE;
5567  }
5568  WerrorS(feNotImplemented);
5569  delete iv;
5570  return TRUE;
5571}
5572static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5573{
5574  PrintS("TODO\n");
5575  int i=pVar((poly)v->Data());
5576  if (i==0)
5577  {
5578    WerrorS("ringvar expected");
5579    return TRUE;
5580  }
5581  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5582  int d=pWTotaldegree(p);
5583  pLmDelete(p);
5584  if (d==1)
5585    res->data = (char *)idHomogen((ideal)u->Data(),i);
5586  else
5587    WerrorS("variable must have weight 1");
5588  return (d!=1);
5589}
5590static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5591{
5592  PrintS("TODO\n");
5593  int i=pVar((poly)v->Data());
5594  if (i==0)
5595  {
5596    WerrorS("ringvar expected");
5597    return TRUE;
5598  }
5599  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5600  int d=pWTotaldegree(p);
5601  pLmDelete(p);
5602  if (d==1)
5603    res->data = (char *)pHomogen((poly)u->Data(),i);
5604  else
5605    WerrorS("variable must have weight 1");
5606  return (d!=1);
5607}
5608static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5609{
5610  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5611  intvec* arg = (intvec*) u->Data();
5612  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5613
5614  for (i=0; i<n; i++)
5615  {
5616    (*im)[i] = (*arg)[i];
5617  }
5618
5619  res->data = (char *)im;
5620  return FALSE;
5621}
5622static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5623{
5624  short *iw=iv2array((intvec *)w->Data());
5625  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5626  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
5627  return FALSE;
5628}
5629static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5630{
5631  if (!pIsUnit((poly)v->Data()))
5632  {
5633    WerrorS("2nd argument must be a unit");
5634    return TRUE;
5635  }
5636  res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
5637  return FALSE;
5638}
5639static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5640{
5641  res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
5642                             (intvec *)w->Data());
5643  return FALSE;
5644}
5645static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5646{
5647  if (!mpIsDiagUnit((matrix)v->Data()))
5648  {
5649    WerrorS("2nd argument must be a diagonal matrix of units");
5650    return TRUE;
5651  }
5652  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5653                               (matrix)v->CopyD());
5654  return FALSE;
5655}
5656static BOOLEAN currRingIsOverIntegralDomain ()
5657{
5658  /* true for fields and Z, false otherwise */
5659  if (rField_is_Ring_PtoM()) return FALSE;
5660  if (rField_is_Ring_2toM()) return FALSE;
5661  if (rField_is_Ring_ModN()) return FALSE;
5662  return TRUE;
5663}
5664static BOOLEAN jjMINOR_M(leftv res, leftv v)
5665{
5666  /* Here's the use pattern for the minor command:
5667        minor ( matrix_expression m, int_expression minorSize,
5668                optional ideal_expression IasSB, optional int_expression k,
5669                optional string_expression algorithm,
5670                optional int_expression cachedMinors,
5671                optional int_expression cachedMonomials )
5672     This method here assumes that there are at least two arguments.
5673     - If IasSB is present, it must be a std basis. All minors will be
5674       reduced w.r.t. IasSB.
5675     - If k is absent, all non-zero minors will be computed.
5676       If k is present and k > 0, the first k non-zero minors will be
5677       computed.
5678       If k is present and k < 0, the first |k| minors (some of which
5679       may be zero) will be computed.
5680       If k is present and k = 0, an error is reported.
5681     - If algorithm is absent, all the following arguments must be absent too.
5682       In this case, a heuristic picks the best-suited algorithm (among
5683       Bareiss, Laplace, and Laplace with caching).
5684       If algorithm is present, it must be one of "Bareiss", "bareiss",
5685       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5686       "cache" two more arguments may be given, determining how many entries
5687       the cache may have at most, and how many cached monomials there are at
5688       most. (Cached monomials are counted over all cached polynomials.)
5689       If these two additional arguments are not provided, 200 and 100000
5690       will be used as defaults.
5691  */
5692  matrix m;
5693  leftv u=v->next;
5694  v->next=NULL;
5695  int v_typ=v->Typ();
5696  if (v_typ==MATRIX_CMD)
5697  {
5698     m = (const matrix)v->Data();
5699  }
5700  else
5701  {
5702    if (v_typ==0)
5703    {
5704      Werror("`%s` is undefined",v->Fullname());
5705      return TRUE;
5706    }
5707    // try to convert to MATRIX:
5708    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5709    BOOLEAN bo;
5710    sleftv tmp;
5711    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5712    else bo=TRUE;
5713    if (bo)
5714    {
5715      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5716      return TRUE;
5717    }
5718    m=(matrix)tmp.data;
5719  }
5720  const int mk = (const int)(long)u->Data();
5721  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5722  bool noCacheMinors = true; bool noCacheMonomials = true;
5723  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5724
5725  /* here come the different cases of correct argument sets */
5726  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5727  {
5728    IasSB = (ideal)u->next->Data();
5729    noIdeal = false;
5730    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5731    {
5732      k = (int)(long)u->next->next->Data();
5733      noK = false;
5734      assume(k != 0);
5735      if ((u->next->next->next != NULL) &&
5736          (u->next->next->next->Typ() == STRING_CMD))
5737      {
5738        algorithm = (char*)u->next->next->next->Data();
5739        noAlgorithm = false;
5740        if ((u->next->next->next->next != NULL) &&
5741            (u->next->next->next->next->Typ() == INT_CMD))
5742        {
5743          cacheMinors = (int)(long)u->next->next->next->next->Data();
5744          noCacheMinors = false;
5745          if ((u->next->next->next->next->next != NULL) &&
5746              (u->next->next->next->next->next->Typ() == INT_CMD))
5747          {
5748            cacheMonomials =
5749               (int)(long)u->next->next->next->next->next->Data();
5750            noCacheMonomials = false;
5751          }
5752        }
5753      }
5754    }
5755  }
5756  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5757  {
5758    k = (int)(long)u->next->Data();
5759    noK = false;
5760    assume(k != 0);
5761    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5762    {
5763      algorithm = (char*)u->next->next->Data();
5764      noAlgorithm = false;
5765      if ((u->next->next->next != NULL) &&
5766          (u->next->next->next->Typ() == INT_CMD))
5767      {
5768        cacheMinors = (int)(long)u->next->next->next->Data();
5769        noCacheMinors = false;
5770        if ((u->next->next->next->next != NULL) &&
5771            (u->next->next->next->next->Typ() == INT_CMD))
5772        {
5773          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5774          noCacheMonomials = false;
5775        }
5776      }
5777    }
5778  }
5779  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5780  {
5781    algorithm = (char*)u->next->Data();
5782    noAlgorithm = false;
5783    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5784    {
5785      cacheMinors = (int)(long)u->next->next->Data();
5786      noCacheMinors = false;
5787      if ((u->next->next->next != NULL) &&
5788          (u->next->next->next->Typ() == INT_CMD))
5789      {
5790        cacheMonomials = (int)(long)u->next->next->next->Data();
5791        noCacheMonomials = false;
5792      }
5793    }
5794  }
5795
5796  /* upper case conversion for the algorithm if present */
5797  if (!noAlgorithm)
5798  {
5799    if (strcmp(algorithm, "bareiss") == 0)
5800      algorithm = (char*)"Bareiss";
5801    if (strcmp(algorithm, "laplace") == 0)
5802      algorithm = (char*)"Laplace";
5803    if (strcmp(algorithm, "cache") == 0)
5804      algorithm = (char*)"Cache";
5805  }
5806
5807  v->next=u;
5808  /* here come some tests */
5809  if (!noIdeal)
5810  {
5811    assumeStdFlag(u->next);
5812  }
5813  if ((!noK) && (k == 0))
5814  {
5815    WerrorS("Provided number of minors to be computed is zero.");
5816    return TRUE;
5817  }
5818  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
5819      && (strcmp(algorithm, "Laplace") != 0)
5820      && (strcmp(algorithm, "Cache") != 0))
5821  {
5822    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
5823    return TRUE;
5824  }
5825  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
5826      && (!currRingIsOverIntegralDomain()))
5827  {
5828    Werror("Bareiss algorithm not defined over coefficient rings %s",
5829           "with zero divisors.");
5830    return TRUE;
5831  }
5832  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
5833  {
5834    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
5835           m->rows(), m->cols());
5836    return TRUE;
5837  }
5838  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
5839      && (noCacheMinors || noCacheMonomials))
5840  {
5841    cacheMinors = 200;
5842    cacheMonomials = 100000;
5843  }
5844
5845  /* here come the actual procedure calls */
5846  if (noAlgorithm)
5847    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
5848                                       (noIdeal ? 0 : IasSB), false);
5849  else if (strcmp(algorithm, "Cache") == 0)
5850    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
5851                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
5852                                   cacheMonomials, false);
5853  else
5854    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
5855                              (noIdeal ? 0 : IasSB), false);
5856  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
5857  res->rtyp = IDEAL_CMD;
5858  return FALSE;
5859}
5860static BOOLEAN jjNEWSTRUCT3(leftv res, leftv u, leftv v, leftv w)
5861{
5862  // u: the name of the new type
5863  // v: the parent type
5864  // w: the elements
5865  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
5866                                            (const char *)w->Data());
5867  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
5868  return d==NULL;
5869}
5870static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
5871{
5872  // handles preimage(r,phi,i) and kernel(r,phi)
5873  idhdl h;
5874  ring rr;
5875  map mapping;
5876  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
5877
5878  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
5879  {
5880    WerrorS("2nd/3rd arguments must have names");
5881    return TRUE;
5882  }
5883  rr=(ring)u->Data();
5884  const char *ring_name=u->Name();
5885  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
5886  {
5887    if (h->typ==MAP_CMD)
5888    {
5889      mapping=IDMAP(h);
5890      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
5891      if ((preim_ring==NULL)
5892      || (IDRING(preim_ring)!=currRing))
5893      {
5894        Werror("preimage ring `%s` is not the basering",mapping->preimage);
5895        return TRUE;
5896      }
5897    }
5898    else if (h->typ==IDEAL_CMD)
5899    {
5900      mapping=IDMAP(h);
5901    }
5902    else
5903    {
5904      Werror("`%s` is no map nor ideal",IDID(h));
5905      return TRUE;
5906    }
5907  }
5908  else
5909  {
5910    Werror("`%s` is not defined in `%s`",v->name,ring_name);
5911    return TRUE;
5912  }
5913  ideal image;
5914  if (kernel_cmd) image=idInit(1,1);
5915  else
5916  {
5917    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
5918    {
5919      if (h->typ==IDEAL_CMD)
5920      {
5921        image=IDIDEAL(h);
5922      }
5923      else
5924      {
5925        Werror("`%s` is no ideal",IDID(h));
5926        return TRUE;
5927      }
5928    }
5929    else
5930    {
5931      Werror("`%s` is not defined in `%s`",w->name,ring_name);
5932      return TRUE;
5933    }
5934  }
5935  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
5936  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
5937  {
5938    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
5939  }
5940  res->data=(char *)maGetPreimage(rr,mapping,image);
5941  if (kernel_cmd) idDelete(&image);
5942  return (res->data==NULL/* is of type ideal, should not be NULL*/);
5943}
5944static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
5945{
5946  int di, k;
5947  int i=(int)(long)u->Data();
5948  int r=(int)(long)v->Data();
5949  int c=(int)(long)w->Data();
5950  if ((r<=0) || (c<=0)) return TRUE;
5951  intvec *iv = new intvec(r, c, 0);
5952  if (iv->rows()==0)
5953  {
5954    delete iv;
5955    return TRUE;
5956  }
5957  if (i!=0)
5958  {
5959    if (i<0) i = -i;
5960    di = 2 * i + 1;
5961    for (k=0; k<iv->length(); k++)
5962    {
5963      (*iv)[k] = ((siRand() % di) - i);
5964    }
5965  }
5966  res->data = (char *)iv;
5967  return FALSE;
5968}
5969static BOOLEAN jjSUBST_Test(leftv v,leftv w,
5970  int &ringvar, poly &monomexpr)
5971{
5972  monomexpr=(poly)w->Data();
5973  poly p=(poly)v->Data();
5974  #if 0
5975  if (pLength(monomexpr)>1)
5976  {
5977    Werror("`%s` substitutes a ringvar only by a term",
5978      Tok2Cmdname(SUBST_CMD));
5979    return TRUE;
5980  }
5981  #endif
5982  if (!(ringvar=pVar(p)))
5983  {
5984    if (rField_is_Extension(currRing))
5985    {
5986      assume(currRing->algring!=NULL);
5987      lnumber n=(lnumber)pGetCoeff(p);
5988      ringvar=-p_Var(n->z,currRing->algring);
5989    }
5990    if(ringvar==0)
5991    {
5992      WerrorS("ringvar/par expected");
5993      return TRUE;
5994    }
5995  }
5996  return FALSE;
5997}
5998static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
5999{
6000  int ringvar;
6001  poly monomexpr;
6002  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6003  if (nok) return TRUE;
6004  poly p=(poly)u->Data();
6005  if (ringvar>0)
6006  {
6007    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6008    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6009    {
6010      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6011      //return TRUE;
6012    }
6013    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6014      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6015    else
6016      res->data= pSubstPoly(p,ringvar,monomexpr);
6017  }
6018  else
6019  {
6020    res->data=pSubstPar(p,-ringvar,monomexpr);
6021  }
6022  return FALSE;
6023}
6024static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6025{
6026  int ringvar;
6027  poly monomexpr;
6028  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6029  if (nok) return TRUE;
6030  if (ringvar>0)
6031  {
6032    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6033      res->data = idSubst((ideal)u->CopyD(res->rtyp),ringvar,monomexpr);
6034    else
6035      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6036  }
6037  else
6038  {
6039    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6040  }
6041  return FALSE;
6042}
6043// we do not want to have jjSUBST_Id_X inlined:
6044static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6045                            int input_type);
6046static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6047{
6048  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6049}
6050static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6051{
6052  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6053}
6054static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6055{
6056  sleftv tmp;
6057  memset(&tmp,0,sizeof(tmp));
6058  // do not check the result, conversion from int/number to poly works always
6059  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6060  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6061  tmp.CleanUp();
6062  return b;
6063}
6064static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6065{
6066  matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
6067  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6068  int i=si_min(IDELEMS(I),(int)(long)v->Data()*(int)(long)w->Data());
6069  //for(i=i-1;i>=0;i--)
6070  //{
6071  //  m->m[i]=I->m[i];
6072  //  I->m[i]=NULL;
6073  //}
6074  memcpy(m->m,I->m,i*sizeof(poly));
6075  memset(I->m,0,i*sizeof(poly));
6076  idDelete(&I);
6077  res->data = (char *)m;
6078  return FALSE;
6079}
6080static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6081{
6082  res->data = (char *)idModule2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6083           (int)(long)v->Data(),(int)(long)w->Data());
6084  return FALSE;
6085}
6086static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6087{
6088  matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
6089  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6090  int r=si_min(MATROWS(I),(int)(long)v->Data());
6091  int c=si_min(MATCOLS(I),(int)(long)w->Data());
6092  int i,j;
6093  for(i=r;i>0;i--)
6094  {
6095    for(j=c;j>0;j--)
6096    {
6097      MATELEM(m,i,j)=MATELEM(I,i,j);
6098      MATELEM(I,i,j)=NULL;
6099    }
6100  }
6101  idDelete((ideal *)&I);
6102  res->data = (char *)m;
6103  return FALSE;
6104}
6105static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6106{
6107  if (w->rtyp!=IDHDL) return TRUE;
6108  BITSET save_test=test;
6109  int ul= IDELEMS((ideal)u->Data());
6110  int vl= IDELEMS((ideal)v->Data());
6111  ideal m
6112    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6113             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6114  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
6115  test=save_test;
6116  return FALSE;
6117}
6118static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6119{
6120  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6121  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6122  idhdl hv=(idhdl)v->data;
6123  idhdl hw=(idhdl)w->data;
6124  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6125  res->data = (char *)idLiftStd((ideal)u->Data(),
6126                                &(hv->data.umatrix),testHomog,
6127                                &(hw->data.uideal));
6128  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6129  return FALSE;
6130}
6131static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6132{
6133  assumeStdFlag(v);
6134  if (!idIsZeroDim((ideal)v->Data()))
6135  {
6136    Werror("`%s` must be 0-dimensional",v->Name());
6137    return TRUE;
6138  }
6139  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6140    (poly)w->CopyD());
6141  return FALSE;
6142}
6143static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6144{
6145  assumeStdFlag(v);
6146  if (!idIsZeroDim((ideal)v->Data()))
6147  {
6148    Werror("`%s` must be 0-dimensional",v->Name());
6149    return TRUE;
6150  }
6151  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6152    (matrix)w->CopyD());
6153  return FALSE;
6154}
6155static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6156{
6157  assumeStdFlag(v);
6158  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6159    0,(int)(long)w->Data());
6160  return FALSE;
6161}
6162static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6163{
6164  assumeStdFlag(v);
6165  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6166    0,(int)(long)w->Data());
6167  return FALSE;
6168}
6169#ifdef OLD_RES
6170static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6171{
6172  int maxl=(int)v->Data();
6173  ideal u_id=(ideal)u->Data();
6174  int l=0;
6175  resolvente r;
6176  intvec **weights=NULL;
6177  int wmaxl=maxl;
6178  maxl--;
6179  if ((maxl==-1) && (iiOp!=MRES_CMD))
6180    maxl = pVariables-1;
6181  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6182  {
6183    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6184    if (iv!=NULL)
6185    {
6186      l=1;
6187      if (!idTestHomModule(u_id,currQuotient,iv))
6188      {
6189        WarnS("wrong weights");
6190        iv=NULL;
6191      }
6192      else
6193      {
6194        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6195        weights[0] = ivCopy(iv);
6196      }
6197    }
6198    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6199  }
6200  else
6201    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6202  if (r==NULL) return TRUE;
6203  int t3=u->Typ();
6204  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6205  return FALSE;
6206}
6207#endif
6208static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6209{
6210  res->data=(void *)rInit(u,v,w);
6211  return (res->data==NULL);
6212}
6213static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6214{
6215  int yes;
6216  jjSTATUS2(res, u, v);
6217  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6218  omFree((ADDRESS) res->data);
6219  res->data = (void *)(long)yes;
6220  return FALSE;
6221}
6222static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6223{
6224  intvec *vw=(intvec *)w->Data(); // weights of vars
6225  if (vw->length()!=currRing->N)
6226  {
6227    Werror("%d weights for %d variables",vw->length(),currRing->N);
6228    return TRUE;
6229  }
6230  ideal result;
6231  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6232  tHomog hom=testHomog;
6233  ideal u_id=(ideal)(u->Data());
6234  if (ww!=NULL)
6235  {
6236    if (!idTestHomModule(u_id,currQuotient,ww))
6237    {
6238      WarnS("wrong weights");
6239      ww=NULL;
6240    }
6241    else
6242    {
6243      ww=ivCopy(ww);
6244      hom=isHomog;
6245    }
6246  }
6247  result=kStd(u_id,
6248              currQuotient,
6249              hom,
6250              &ww,                  // module weights
6251              (intvec *)v->Data(),  // hilbert series
6252              0,0,                  // syzComp, newIdeal
6253              vw);                  // weights of vars
6254  idSkipZeroes(result);
6255  res->data = (char *)result;
6256  setFlag(res,FLAG_STD);
6257  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6258  return FALSE;
6259}
6260
6261/*=================== operations with many arg.: static proc =================*/
6262/* must be ordered: first operations for chars (infix ops),
6263 * then alphabetically */
6264static BOOLEAN jjBREAK0(leftv res, leftv v)
6265{
6266#ifdef HAVE_SDB
6267  sdb_show_bp();
6268#endif
6269  return FALSE;
6270}
6271static BOOLEAN jjBREAK1(leftv res, leftv v)
6272{
6273#ifdef HAVE_SDB
6274  if(v->Typ()==PROC_CMD)
6275  {
6276    int lineno=0;
6277    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6278    {
6279      lineno=(int)(long)v->next->Data();
6280    }
6281    return sdb_set_breakpoint(v->Name(),lineno);
6282  }
6283  return TRUE;
6284#else
6285 return FALSE;
6286#endif
6287}
6288static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6289{
6290  return iiExprArith1(res,v,iiOp);
6291}
6292static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6293{
6294  leftv v=u->next;
6295  u->next=NULL;
6296  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6297  u->next=v;
6298  return b;
6299}
6300static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6301{
6302  leftv v = u->next;
6303  leftv w = v->next;
6304  u->next = NULL;
6305  v->next = NULL;
6306  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6307  u->next = v;
6308  v->next = w;
6309  return b;
6310}
6311
6312static BOOLEAN jjCOEF_M(leftv res, leftv v)
6313{
6314  if((v->Typ() != VECTOR_CMD)
6315  || (v->next->Typ() != POLY_CMD)
6316  || (v->next->next->Typ() != MATRIX_CMD)
6317  || (v->next->next->next->Typ() != MATRIX_CMD))
6318     return TRUE;
6319  if (v->next->next->rtyp!=IDHDL) return TRUE;
6320  idhdl c=(idhdl)v->next->next->data;
6321  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6322  idhdl m=(idhdl)v->next->next->next->data;
6323  idDelete((ideal *)&(c->data.uideal));
6324  idDelete((ideal *)&(m->data.uideal));
6325  mpCoef2((poly)v->Data(),(poly)v->next->Data(),
6326    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix));
6327  return FALSE;
6328}
6329
6330static BOOLEAN jjDIVISION4(leftv res, leftv v)
6331{ // may have 3 or 4 arguments
6332  leftv v1=v;
6333  leftv v2=v1->next;
6334  leftv v3=v2->next;
6335  leftv v4=v3->next;
6336  assumeStdFlag(v2);
6337
6338  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6339  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6340
6341  if((i1==0)||(i2==0)
6342  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6343  {
6344    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6345    return TRUE;
6346  }
6347
6348  sleftv w1,w2;
6349  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6350  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6351  ideal P=(ideal)w1.Data();
6352  ideal Q=(ideal)w2.Data();
6353
6354  int n=(int)(long)v3->Data();
6355  short *w=NULL;
6356  if(v4!=NULL)
6357  {
6358    w=iv2array((intvec *)v4->Data());
6359    short *w0=w+1;
6360    int i=pVariables;
6361    while(i>0&&*w0>0)
6362    {
6363      w0++;
6364      i--;
6365    }
6366    if(i>0)
6367      WarnS("not all weights are positive!");
6368  }
6369
6370  matrix T;
6371  ideal R;
6372  idLiftW(P,Q,n,T,R,w);
6373
6374  w1.CleanUp();
6375  w2.CleanUp();
6376  if(w!=NULL)
6377    omFree(w);
6378
6379  lists L=(lists) omAllocBin(slists_bin);
6380  L->Init(2);
6381  L->m[1].rtyp=v1->Typ();
6382  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6383  {
6384    if(v1->Typ()==POLY_CMD)
6385      pShift(&R->m[0],-1);
6386    L->m[1].data=(void *)R->m[0];
6387    R->m[0]=NULL;
6388    idDelete(&R);
6389  }
6390  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6391    L->m[1].data=(void *)idModule2Matrix(R);
6392  else
6393  {
6394    L->m[1].rtyp=MODUL_CMD;
6395    L->m[1].data=(void *)R;
6396  }
6397  L->m[0].rtyp=MATRIX_CMD;
6398  L->m[0].data=(char *)T;
6399
6400  res->data=L;
6401  res->rtyp=LIST_CMD;
6402
6403  return FALSE;
6404}
6405
6406//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6407//{
6408//  int l=u->listLength();
6409//  if (l<2) return TRUE;
6410//  BOOLEAN b;
6411//  leftv v=u->next;
6412//  leftv zz=v;
6413//  leftv z=zz;
6414//  u->next=NULL;
6415//  do
6416//  {
6417//    leftv z=z->next;
6418//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6419//    if (b) break;
6420//  } while (z!=NULL);
6421//  u->next=zz;
6422//  return b;
6423//}
6424static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6425{
6426  int s=1;
6427  leftv h=v;
6428  if (h!=NULL) s=exprlist_length(h);
6429  ideal id=idInit(s,1);
6430  int rank=1;
6431  int i=0;
6432  poly p;
6433  while (h!=NULL)
6434  {
6435    switch(h->Typ())
6436    {
6437      case POLY_CMD:
6438      {
6439        p=(poly)h->CopyD(POLY_CMD);
6440        break;
6441      }
6442      case INT_CMD:
6443      {
6444        number n=nInit((int)(long)h->Data());
6445        if (!nIsZero(n))
6446        {
6447          p=pNSet(n);
6448        }
6449        else
6450        {
6451          p=NULL;
6452          nDelete(&n);
6453        }
6454        break;
6455      }
6456      case BIGINT_CMD:
6457      {
6458        number b=(number)h->Data();
6459        number n=nInit_bigint(b);
6460        if (!nIsZero(n))
6461        {
6462          p=pNSet(n);
6463        }
6464        else
6465        {
6466          p=NULL;
6467          nDelete(&n);
6468        }
6469        break;
6470      }
6471      case NUMBER_CMD:
6472      {
6473        number n=(number)h->CopyD(NUMBER_CMD);
6474        if (!nIsZero(n))
6475        {
6476          p=pNSet(n);
6477        }
6478        else
6479        {
6480          p=NULL;
6481          nDelete(&n);
6482        }
6483        break;
6484      }
6485      case VECTOR_CMD:
6486      {
6487        p=(poly)h->CopyD(VECTOR_CMD);
6488        if (iiOp!=MODUL_CMD)
6489        {
6490          idDelete(&id);
6491          pDelete(&p);
6492          return TRUE;
6493        }
6494        rank=si_max(rank,(int)pMaxComp(p));
6495        break;
6496      }
6497      default:
6498      {
6499        idDelete(&id);
6500        return TRUE;
6501      }
6502    }
6503    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6504    {
6505      pSetCompP(p,1);
6506    }
6507    id->m[i]=p;
6508    i++;
6509    h=h->next;
6510  }
6511  id->rank=rank;
6512  res->data=(char *)id;
6513  return FALSE;
6514}
6515static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6516{
6517  leftv h=v;
6518  int l=v->listLength();
6519  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6520  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6521  int t=0;
6522  // try to convert to IDEAL_CMD
6523  while (h!=NULL)
6524  {
6525    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6526    {
6527      t=IDEAL_CMD;
6528    }
6529    else break;
6530    h=h->next;
6531  }
6532  // if failure, try MODUL_CMD
6533  if (t==0)
6534  {
6535    h=v;
6536    while (h!=NULL)
6537    {
6538      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6539      {
6540        t=MODUL_CMD;
6541      }
6542      else break;
6543      h=h->next;
6544    }
6545  }
6546  // check for success  in converting
6547  if (t==0)
6548  {
6549    WerrorS("cannot convert to ideal or module");
6550    return TRUE;
6551  }
6552  // call idMultSect
6553  h=v;
6554  int i=0;
6555  sleftv tmp;
6556  while (h!=NULL)
6557  {
6558    if (h->Typ()==t)
6559    {
6560      r[i]=(ideal)h->Data(); /*no copy*/
6561      h=h->next;
6562    }
6563    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6564    {
6565      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6566      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6567      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6568      return TRUE;
6569    }
6570    else
6571    {
6572      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6573      copied[i]=TRUE;
6574      h=tmp.next;
6575    }
6576    i++;
6577  }
6578  res->rtyp=t;
6579  res->data=(char *)idMultSect(r,i);
6580  while(i>0)
6581  {
6582    i--;
6583    if (copied[i]) idDelete(&(r[i]));
6584  }
6585  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6586  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6587  return FALSE;
6588}
6589static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6590{
6591  /* computation of the inverse of a quadratic matrix A
6592     using the L-U-decomposition of A;
6593     There are two valid parametrisations:
6594     1) exactly one argument which is just the matrix A,
6595     2) exactly three arguments P, L, U which already
6596        realise the L-U-decomposition of A, that is,
6597        P * A = L * U, and P, L, and U satisfy the
6598        properties decribed in method 'jjLU_DECOMP';
6599        see there;
6600     If A is invertible, the list [1, A^(-1)] is returned,
6601     otherwise the list [0] is returned. Thus, the user may
6602     inspect the first entry of the returned list to see
6603     whether A is invertible. */
6604  matrix iMat; int invertible;
6605  if (v->next == NULL)
6606  {
6607    if (v->Typ() != MATRIX_CMD)
6608    {
6609      Werror("expected either one or three matrices");
6610      return TRUE;
6611    }
6612    else
6613    {
6614      matrix aMat = (matrix)v->Data();
6615      int rr = aMat->rows();
6616      int cc = aMat->cols();
6617      if (rr != cc)
6618      {
6619        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6620        return TRUE;
6621      }
6622      invertible = luInverse(aMat, iMat);
6623    }
6624  }
6625  else if ((v->Typ() == MATRIX_CMD) &&
6626           (v->next->Typ() == MATRIX_CMD) &&
6627           (v->next->next != NULL) &&
6628           (v->next->next->Typ() == MATRIX_CMD) &&
6629           (v->next->next->next == NULL))
6630  {
6631     matrix pMat = (matrix)v->Data();
6632     matrix lMat = (matrix)v->next->Data();
6633     matrix uMat = (matrix)v->next->next->Data();
6634     int rr = uMat->rows();
6635     int cc = uMat->cols();
6636     if (rr != cc)
6637     {
6638       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6639              rr, cc);
6640       return TRUE;
6641     }
6642     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6643  }
6644  else
6645  {
6646    Werror("expected either one or three matrices");
6647    return TRUE;
6648  }
6649
6650  /* build the return structure; a list with either one or two entries */
6651  lists ll = (lists)omAllocBin(slists_bin);
6652  if (invertible)
6653  {
6654    ll->Init(2);
6655    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6656    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6657  }
6658  else
6659  {
6660    ll->Init(1);
6661    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6662  }
6663
6664  res->data=(char*)ll;
6665  return FALSE;
6666}
6667static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6668{
6669  /* for solving a linear equation system A * x = b, via the
6670     given LU-decomposition of the matrix A;
6671     There is one valid parametrisation:
6672     1) exactly four arguments P, L, U, b;
6673        P, L, and U realise the L-U-decomposition of A, that is,
6674        P * A = L * U, and P, L, and U satisfy the
6675        properties decribed in method 'jjLU_DECOMP';
6676        see there;
6677        b is the right-hand side vector of the equation system;
6678     The method will return a list of either 1 entry or three entries:
6679     1) [0] if there is no solution to the system;
6680     2) [1, x, H] if there is at least one solution;
6681        x is any solution of the given linear system,
6682        H is the matrix with column vectors spanning the homogeneous
6683        solution space.
6684     The method produces an error if matrix and vector sizes do not fit. */
6685  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
6686      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
6687      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
6688      (v->next->next->next == NULL) ||
6689      (v->next->next->next->Typ() != MATRIX_CMD) ||
6690      (v->next->next->next->next != NULL))
6691  {
6692    WerrorS("expected exactly three matrices and one vector as input");
6693    return TRUE;
6694  }
6695  matrix pMat = (matrix)v->Data();
6696  matrix lMat = (matrix)v->next->Data();
6697  matrix uMat = (matrix)v->next->next->Data();
6698  matrix bVec = (matrix)v->next->next->next->Data();
6699  matrix xVec; int solvable; matrix homogSolSpace;
6700  if (pMat->rows() != pMat->cols())
6701  {
6702    Werror("first matrix (%d x %d) is not quadratic",
6703           pMat->rows(), pMat->cols());
6704    return TRUE;
6705  }
6706  if (lMat->rows() != lMat->cols())
6707  {
6708    Werror("second matrix (%d x %d) is not quadratic",
6709           lMat->rows(), lMat->cols());
6710    return TRUE;
6711  }
6712  if (lMat->rows() != uMat->rows())
6713  {
6714    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
6715           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
6716    return TRUE;
6717  }
6718  if (uMat->rows() != bVec->rows())
6719  {
6720    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
6721           uMat->rows(), uMat->cols(), bVec->rows());
6722    return TRUE;
6723  }
6724  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
6725
6726  /* build the return structure; a list with either one or three entries */
6727  lists ll = (lists)omAllocBin(slists_bin);
6728  if (solvable)
6729  {
6730    ll->Init(3);
6731    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6732    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
6733    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
6734  }
6735  else
6736  {
6737    ll->Init(1);
6738    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6739  }
6740
6741  res->data=(char*)ll;
6742  return FALSE;
6743}
6744static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
6745{
6746  int i=0;
6747  leftv h=v;
6748  if (h!=NULL) i=exprlist_length(h);
6749  intvec *iv=new intvec(i);
6750  i=0;
6751  while (h!=NULL)
6752  {
6753    if(h->Typ()==INT_CMD)
6754    {
6755      (*iv)[i]=(int)(long)h->Data();
6756    }
6757    else
6758    {
6759      delete iv;
6760      return TRUE;
6761    }
6762    i++;
6763    h=h->next;
6764  }
6765  res->data=(char *)iv;
6766  return FALSE;
6767}
6768static BOOLEAN jjJET4(leftv res, leftv u)
6769{
6770  leftv u1=u;
6771  leftv u2=u1->next;
6772  leftv u3=u2->next;
6773  leftv u4=u3->next;
6774  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6775  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
6776  {
6777    if(!pIsUnit((poly)u2->Data()))
6778    {
6779      WerrorS("2nd argument must be a unit");
6780      return TRUE;
6781    }
6782    res->rtyp=u1->Typ();
6783    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
6784                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
6785    return FALSE;
6786  }
6787  else
6788  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6789  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
6790  {
6791    if(!mpIsDiagUnit((matrix)u2->Data()))
6792    {
6793      WerrorS("2nd argument must be a diagonal matrix of units");
6794      return TRUE;
6795    }
6796    res->rtyp=u1->Typ();
6797    res->data=(char*)idSeries((int)(long)u3->Data(),idCopy((ideal)u1->Data()),
6798                              mpCopy((matrix)u2->Data()),(intvec*)u4->Data());
6799    return FALSE;
6800  }
6801  else
6802  {
6803    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
6804           Tok2Cmdname(iiOp));
6805    return TRUE;
6806  }
6807}
6808static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
6809{
6810  if ((yyInRingConstruction)
6811  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
6812  {
6813    memcpy(res,u,sizeof(sleftv));
6814    memset(u,0,sizeof(sleftv));
6815    return FALSE;
6816  }
6817  leftv v=u->next;
6818  BOOLEAN b;
6819  if(v==NULL)
6820    b=iiExprArith1(res,u,iiOp);
6821  else
6822  {
6823    u->next=NULL;
6824    b=iiExprArith2(res,u,iiOp,v);
6825    u->next=v;
6826  }
6827  return b;
6828}
6829BOOLEAN jjLIST_PL(leftv res, leftv v)
6830{
6831  int sl=0;
6832  if (v!=NULL) sl = v->listLength();
6833  lists L;
6834  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
6835  {
6836    int add_row_shift = 0;
6837    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
6838    if (weights!=NULL)  add_row_shift=weights->min_in();
6839    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
6840  }
6841  else
6842  {
6843    L=(lists)omAllocBin(slists_bin);
6844    leftv h=NULL;
6845    int i;
6846    int rt;
6847
6848    L->Init(sl);
6849    for (i=0;i<sl;i++)
6850    {
6851      if (h!=NULL)
6852      { /* e.g. not in the first step:
6853         * h is the pointer to the old sleftv,
6854         * v is the pointer to the next sleftv
6855         * (in this moment) */
6856         h->next=v;
6857      }
6858      h=v;
6859      v=v->next;
6860      h->next=NULL;
6861      rt=h->Typ();
6862      if (rt==0)
6863      {
6864        L->Clean();
6865        Werror("`%s` is undefined",h->Fullname());
6866        return TRUE;
6867      }
6868      if ((rt==RING_CMD)||(rt==QRING_CMD))
6869      {
6870        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
6871        ((ring)L->m[i].data)->ref++;
6872      }
6873      else
6874        L->m[i].Copy(h);
6875    }
6876  }
6877  res->data=(char *)L;
6878  return FALSE;
6879}
6880static BOOLEAN jjNAMES0(leftv res, leftv v)
6881{
6882  res->data=(void *)ipNameList(IDROOT);
6883  return FALSE;
6884}
6885static BOOLEAN jjOPTION_PL(leftv res, leftv v)
6886{
6887  if(v==NULL)
6888  {
6889    res->data=(char *)showOption();
6890    return FALSE;
6891  }
6892  res->rtyp=NONE;
6893  return setOption(res,v);
6894}
6895static BOOLEAN jjREDUCE4(leftv res, leftv u)
6896{
6897  leftv u1=u;
6898  leftv u2=u1->next;
6899  leftv u3=u2->next;
6900  leftv u4=u3->next;
6901  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
6902  {
6903    int save_d=Kstd1_deg;
6904    Kstd1_deg=(int)(long)u3->Data();
6905    kModW=(intvec *)u4->Data();
6906    BITSET save=verbose;
6907    verbose|=Sy_bit(V_DEG_STOP);
6908    u2->next=NULL;
6909    BOOLEAN r=jjCALL2ARG(res,u);
6910    kModW=NULL;
6911    Kstd1_deg=save_d;
6912    verbose=save;
6913    u->next->next=u3;
6914    return r;
6915  }
6916  else
6917  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6918     (u4->Typ()==INT_CMD))
6919  {
6920    assumeStdFlag(u3);
6921    if(!mpIsDiagUnit((matrix)u2->Data()))
6922    {
6923      WerrorS("2nd argument must be a diagonal matrix of units");
6924      return TRUE;
6925    }
6926    res->rtyp=IDEAL_CMD;
6927    res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
6928                           mpCopy((matrix)u2->Data()),(int)(long)u4->Data());
6929    return FALSE;
6930  }
6931  else
6932  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6933     (u4->Typ()==INT_CMD))
6934  {
6935    assumeStdFlag(u3);
6936    if(!pIsUnit((poly)u2->Data()))
6937    {
6938      WerrorS("2nd argument must be a unit");
6939      return TRUE;
6940    }
6941    res->rtyp=POLY_CMD;
6942    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
6943                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
6944    return FALSE;
6945  }
6946  else
6947  {
6948    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
6949    return TRUE;
6950  }
6951}
6952static BOOLEAN jjREDUCE5(leftv res, leftv u)
6953{
6954  leftv u1=u;
6955  leftv u2=u1->next;
6956  leftv u3=u2->next;
6957  leftv u4=u3->next;
6958  leftv u5=u4->next;
6959  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6960     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
6961  {
6962    assumeStdFlag(u3);
6963    if(!mpIsDiagUnit((matrix)u2->Data()))
6964    {
6965      WerrorS("2nd argument must be a diagonal matrix of units");
6966      return TRUE;
6967    }
6968    res->rtyp=IDEAL_CMD;
6969    res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
6970                           mpCopy((matrix)u2->Data()),
6971                           (int)(long)u4->Data(),(intvec*)u5->Data());
6972    return FALSE;
6973  }
6974  else
6975  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6976     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
6977  {
6978    assumeStdFlag(u3);
6979    if(!pIsUnit((poly)u2->Data()))
6980    {
6981      WerrorS("2nd argument must be a unit");
6982      return TRUE;
6983    }
6984    res->rtyp=POLY_CMD;
6985    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
6986                           pCopy((poly)u2->Data()),
6987                           (int)(long)u4->Data(),(intvec*)u5->Data());
6988    return FALSE;
6989  }
6990  else
6991  {
6992    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
6993           Tok2Cmdname(iiOp));
6994    return TRUE;
6995  }
6996}
6997static BOOLEAN jjRESERVED0(leftv res, leftv v)
6998{
6999  int i=1;
7000  int nCount = (sArithBase.nCmdUsed-1)/3;
7001  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7002  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7003  //      sArithBase.nCmdAllocated);
7004  for(i=0; i<nCount; i++)
7005  {
7006    Print("%-20s",sArithBase.sCmds[i+1].name);
7007    if(i+1+nCount<sArithBase.nCmdUsed)
7008      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7009    if(i+1+2*nCount<sArithBase.nCmdUsed)
7010      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7011    //if ((i%3)==1) PrintLn();
7012    PrintLn();
7013  }
7014  PrintLn();
7015  printBlackboxTypes();
7016  return FALSE;
7017}
7018static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7019{
7020  if (v == NULL)
7021  {
7022    res->data = omStrDup("");
7023    return FALSE;
7024  }
7025  int n = v->listLength();
7026  if (n == 1)
7027  {
7028    res->data = v->String();
7029    return FALSE;
7030  }
7031
7032  char** slist = (char**) omAlloc(n*sizeof(char*));
7033  int i, j;
7034
7035  for (i=0, j=0; i<n; i++, v = v ->next)
7036  {
7037    slist[i] = v->String();
7038    assume(slist[i] != NULL);
7039    j+=strlen(slist[i]);
7040  }
7041  char* s = (char*) omAlloc((j+1)*sizeof(char));
7042  *s='\0';
7043  for (i=0;i<n;i++)
7044  {
7045    strcat(s, slist[i]);
7046    omFree(slist[i]);
7047  }
7048  omFreeSize(slist, n*sizeof(char*));
7049  res->data = s;
7050  return FALSE;
7051}
7052static BOOLEAN jjTEST(leftv res, leftv v)
7053{
7054  do
7055  {
7056    if (v->Typ()!=INT_CMD)
7057      return TRUE;
7058    test_cmd((int)(long)v->Data());
7059    v=v->next;
7060  }
7061  while (v!=NULL);
7062  return FALSE;
7063}
7064
7065#if defined(__alpha) && !defined(linux)
7066extern "C"
7067{
7068  void usleep(unsigned long usec);
7069};
7070#endif
7071static BOOLEAN jjFactModD_M(leftv res, leftv v)
7072{
7073  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7074     see a detailed documentation in /kernel/linearAlgebra.h
7075
7076     valid argument lists:
7077     - (poly h, int d),
7078     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7079     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7080                                                          in list of ring vars,
7081     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7082                                                optional: all 4 optional args
7083     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7084      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7085      has exactly two distinct monic factors [possibly with exponent > 1].)
7086     result:
7087     - list with the two factors f and g such that
7088       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7089
7090  poly h      = NULL;
7091  int  d      =    1;
7092  poly f0     = NULL;
7093  poly g0     = NULL;
7094  int  xIndex =    1;   /* default index if none provided */
7095  int  yIndex =    2;   /* default index if none provided */
7096
7097  leftv u = v; int factorsGiven = 0;
7098  if ((u == NULL) || (u->Typ() != POLY_CMD))
7099  {
7100    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7101    return TRUE;
7102  }
7103  else h = (poly)u->Data();
7104  u = u->next;
7105  if ((u == NULL) || (u->Typ() != INT_CMD))
7106  {
7107    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7108    return TRUE;
7109  }
7110  else d = (int)(long)u->Data();
7111  u = u->next;
7112  if ((u != NULL) && (u->Typ() == POLY_CMD))
7113  {
7114    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7115    {
7116      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7117      return TRUE;
7118    }
7119    else
7120    {
7121      f0 = (poly)u->Data();
7122      g0 = (poly)u->next->Data();
7123      factorsGiven = 1;
7124      u = u->next->next;
7125    }
7126  }
7127  if ((u != NULL) && (u->Typ() == INT_CMD))
7128  {
7129    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7130    {
7131      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7132      return TRUE;
7133    }
7134    else
7135    {
7136      xIndex = (int)(long)u->Data();
7137      yIndex = (int)(long)u->next->Data();
7138      u = u->next->next;
7139    }
7140  }
7141  if (u != NULL)
7142  {
7143    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7144    return TRUE;
7145  }
7146
7147  /* checks for provided arguments */
7148  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7149  {
7150    WerrorS("expected non-constant polynomial argument(s)");
7151    return TRUE;
7152  }
7153  int n = rVar(currRing);
7154  if ((xIndex < 1) || (n < xIndex))
7155  {
7156    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7157    return TRUE;
7158  }
7159  if ((yIndex < 1) || (n < yIndex))
7160  {
7161    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7162    return TRUE;
7163  }
7164  if (xIndex == yIndex)
7165  {
7166    WerrorS("expected distinct indices for variables x and y");
7167    return TRUE;
7168  }
7169
7170  /* computation of f0 and g0 if missing */
7171  if (factorsGiven == 0)
7172  {
7173#ifdef HAVE_FACTORY
7174    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7175    intvec* v = NULL;
7176    ideal i = singclap_factorize(h0, &v, 0);
7177
7178    ivTest(v);
7179
7180    if (i == NULL) return TRUE;
7181
7182    idTest(i);
7183
7184    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7185    {
7186      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7187      return TRUE;
7188    }
7189    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7190    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7191    idDelete(&i);
7192#else
7193    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7194    return TRUE;
7195#endif
7196  }
7197
7198  poly f; poly g;
7199  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7200  lists L = (lists)omAllocBin(slists_bin);
7201  L->Init(2);
7202  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7203  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7204  res->rtyp = LIST_CMD;
7205  res->data = (char*)L;
7206  return FALSE;
7207}
7208static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7209{
7210  if ((v->Typ() != LINK_CMD) ||
7211      (v->next->Typ() != STRING_CMD) ||
7212      (v->next->next->Typ() != STRING_CMD) ||
7213      (v->next->next->next->Typ() != INT_CMD))
7214    return TRUE;
7215  jjSTATUS3(res, v, v->next, v->next->next);
7216#if defined(HAVE_USLEEP)
7217  if (((long) res->data) == 0L)
7218  {
7219    int i_s = (int)(long) v->next->next->next->Data();
7220    if (i_s > 0)
7221    {
7222      usleep((int)(long) v->next->next->next->Data());
7223      jjSTATUS3(res, v, v->next, v->next->next);
7224    }
7225  }
7226#elif defined(HAVE_SLEEP)
7227  if (((int) res->data) == 0)
7228  {
7229    int i_s = (int) v->next->next->next->Data();
7230    if (i_s > 0)
7231    {
7232      sleep((is - 1)/1000000 + 1);
7233      jjSTATUS3(res, v, v->next, v->next->next);
7234    }
7235  }
7236#endif
7237  return FALSE;
7238}
7239static BOOLEAN jjSUBST_M(leftv res, leftv u)
7240{
7241  leftv v = u->next; // number of args > 0
7242  if (v==NULL) return TRUE;
7243  leftv w = v->next;
7244  if (w==NULL) return TRUE;
7245  leftv rest = w->next;;
7246
7247  u->next = NULL;
7248  v->next = NULL;
7249  w->next = NULL;
7250  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7251  if ((rest!=NULL) && (!b))
7252  {
7253    sleftv tmp_res;
7254    leftv tmp_next=res->next;
7255    res->next=rest;
7256    memset(&tmp_res,0,sizeof(tmp_res));
7257    b = iiExprArithM(&tmp_res,res,iiOp);
7258    memcpy(res,&tmp_res,sizeof(tmp_res));
7259    res->next=tmp_next;
7260  }
7261  u->next = v;
7262  v->next = w;
7263  // rest was w->next, but is already cleaned
7264  return b;
7265}
7266static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7267{
7268  if ((INPUT->Typ() != MATRIX_CMD) ||
7269      (INPUT->next->Typ() != NUMBER_CMD) ||
7270      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7271      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7272  {
7273    WerrorS("expected (matrix, number, number, number) as arguments");
7274    return TRUE;
7275  }
7276  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7277  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7278                                    (number)(v->Data()),
7279                                    (number)(w->Data()),
7280                                    (number)(x->Data()));
7281  return FALSE;
7282}
7283static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7284{ ideal result;
7285  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7286  leftv v = u->next;  /* one additional polynomial or ideal */
7287  leftv h = v->next;  /* Hilbert vector */
7288  leftv w = h->next;  /* weight vector */
7289  assumeStdFlag(u);
7290  ideal i1=(ideal)(u->Data());
7291  ideal i0;
7292  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7293  || (h->Typ()!=INTVEC_CMD)
7294  || (w->Typ()!=INTVEC_CMD))
7295  {
7296    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7297    return TRUE;
7298  }
7299  intvec *vw=(intvec *)w->Data(); // weights of vars
7300  /* merging std_hilb_w and std_1 */
7301  if (vw->length()!=currRing->N)
7302  {
7303    Werror("%d weights for %d variables",vw->length(),currRing->N);
7304    return TRUE;
7305  }
7306  int r=v->Typ();
7307  BOOLEAN cleanup_i0=FALSE;
7308  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7309  {
7310    i0=idInit(1,i1->rank);
7311    i0->m[0]=(poly)v->Data();
7312    BOOLEAN cleanup_i0=TRUE;
7313  }
7314  else if (r==IDEAL_CMD)/* IDEAL */
7315  {
7316    i0=(ideal)v->Data();
7317  }
7318  else
7319  {
7320    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7321    return TRUE;
7322  }
7323  int ii0=idElem(i0);
7324  i1 = idSimpleAdd(i1,i0);
7325  if (cleanup_i0)
7326  {
7327    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7328    idDelete(&i0);
7329  }
7330  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7331  tHomog hom=testHomog;
7332  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7333  if (ww!=NULL)
7334  {
7335    if (!idTestHomModule(i1,currQuotient,ww))
7336    {
7337      WarnS("wrong weights");
7338      ww=NULL;
7339    }
7340    else
7341    {
7342      ww=ivCopy(ww);
7343      hom=isHomog;
7344    }
7345  }
7346  BITSET save_test=test;
7347  test|=Sy_bit(OPT_SB_1);
7348  result=kStd(i1,
7349              currQuotient,
7350              hom,
7351              &ww,                  // module weights
7352              (intvec *)h->Data(),  // hilbert series
7353              0,                    // syzComp, whatever it is...
7354              IDELEMS(i1)-ii0,      // new ideal
7355              vw);                  // weights of vars
7356  test=save_test;
7357  idDelete(&i1);
7358  idSkipZeroes(result);
7359  res->data = (char *)result;
7360  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7361  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7362  return FALSE;
7363}
7364
7365
7366#ifdef MDEBUG
7367static Subexpr jjDBMakeSub(leftv e,const char *f,const int l)
7368#else
7369static Subexpr jjMakeSub(leftv e)
7370#endif
7371{
7372  assume( e->Typ()==INT_CMD );
7373  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7374  r->start =(int)(long)e->Data();
7375  return r;
7376}
7377#define D(A) (A)
7378#define IPARITH
7379#include "table.h"
7380
7381#include <iparith.inc>
7382
7383/*=================== operations with 2 args. ============================*/
7384/* must be ordered: first operations for chars (infix ops),
7385 * then alphabetically */
7386
7387BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7388{
7389  memset(res,0,sizeof(sleftv));
7390  BOOLEAN call_failed=FALSE;
7391
7392  if (!errorreported)
7393  {
7394#ifdef SIQ
7395    if (siq>0)
7396    {
7397      //Print("siq:%d\n",siq);
7398      command d=(command)omAlloc0Bin(sip_command_bin);
7399      memcpy(&d->arg1,a,sizeof(sleftv));
7400      //a->Init();
7401      memcpy(&d->arg2,b,sizeof(sleftv));
7402      //b->Init();
7403      d->argc=2;
7404      d->op=op;
7405      res->data=(char *)d;
7406      res->rtyp=COMMAND;
7407      return FALSE;
7408    }
7409#endif
7410    int at=a->Typ();
7411    if (at>MAX_TOK)
7412    {
7413      blackbox *bb=getBlackboxStuff(at);
7414      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7415      else          return TRUE;
7416    }
7417    int bt=b->Typ();
7418    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7419    int index=i;
7420
7421    iiOp=op;
7422    while (dArith2[i].cmd==op)
7423    {
7424      if ((at==dArith2[i].arg1)
7425      && (bt==dArith2[i].arg2))
7426      {
7427        res->rtyp=dArith2[i].res;
7428        if (currRing!=NULL)
7429        {
7430          if (check_valid(dArith2[i].valid_for,op)) break;
7431        }
7432        if (TEST_V_ALLWARN)
7433          Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt));
7434        if ((call_failed=dArith2[i].p(res,a,b)))
7435        {
7436          break;// leave loop, goto error handling
7437        }
7438        a->CleanUp();
7439        b->CleanUp();
7440        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7441        return FALSE;
7442      }
7443      i++;
7444    }
7445    // implicite type conversion ----------------------------------------------
7446    if (dArith2[i].cmd!=op)
7447    {
7448      int ai,bi;
7449      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7450      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7451      BOOLEAN failed=FALSE;
7452      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7453      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7454      while (dArith2[i].cmd==op)
7455      {
7456        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7457        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7458        {
7459          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7460          {
7461            res->rtyp=dArith2[i].res;
7462            if (currRing!=NULL)
7463            {
7464              if (check_valid(dArith2[i].valid_for,op)) break;
7465            }
7466            if (TEST_V_ALLWARN)
7467              Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),
7468              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7469            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7470            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7471            || (call_failed=dArith2[i].p(res,an,bn)));
7472            // everything done, clean up temp. variables
7473            if (failed)
7474            {
7475              // leave loop, goto error handling
7476              break;
7477            }
7478            else
7479            {
7480              // everything ok, clean up and return
7481              an->CleanUp();
7482              bn->CleanUp();
7483              omFreeBin((ADDRESS)an, sleftv_bin);
7484              omFreeBin((ADDRESS)bn, sleftv_bin);
7485              a->CleanUp();
7486              b->CleanUp();
7487              return FALSE;
7488            }
7489          }
7490        }
7491        i++;
7492      }
7493      an->CleanUp();
7494      bn->CleanUp();
7495      omFreeBin((ADDRESS)an, sleftv_bin);
7496      omFreeBin((ADDRESS)bn, sleftv_bin);
7497    }
7498    // error handling ---------------------------------------------------
7499    const char *s=NULL;
7500    if (!errorreported)
7501    {
7502      if ((at==0) && (a->Fullname()!=sNoName))
7503      {
7504        s=a->Fullname();
7505      }
7506      else if ((bt==0) && (b->Fullname()!=sNoName))
7507      {
7508        s=b->Fullname();
7509      }
7510      if (s!=NULL)
7511        Werror("`%s` is not defined",s);
7512      else
7513      {
7514        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7515        s = iiTwoOps(op);
7516        if (proccall)
7517        {
7518          Werror("%s(`%s`,`%s`) failed"
7519                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7520        }
7521        else
7522        {
7523          Werror("`%s` %s `%s` failed"
7524                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7525        }
7526        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7527        {
7528          while (dArith2[i].cmd==op)
7529          {
7530            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7531            && (dArith2[i].res!=0)
7532            && (dArith2[i].p!=jjWRONG2))
7533            {
7534              if (proccall)
7535                Werror("expected %s(`%s`,`%s`)"
7536                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7537              else
7538                Werror("expected `%s` %s `%s`"
7539                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7540            }
7541            i++;
7542          }
7543        }
7544      }
7545    }
7546    res->rtyp = UNKNOWN;
7547  }
7548  a->CleanUp();
7549  b->CleanUp();
7550  return TRUE;
7551}
7552
7553/*==================== operations with 1 arg. ===============================*/
7554/* must be ordered: first operations for chars (infix ops),
7555 * then alphabetically */
7556
7557BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7558{
7559  memset(res,0,sizeof(sleftv));
7560  BOOLEAN call_failed=FALSE;
7561
7562  if (!errorreported)
7563  {
7564#ifdef SIQ
7565    if (siq>0)
7566    {
7567      //Print("siq:%d\n",siq);
7568      command d=(command)omAlloc0Bin(sip_command_bin);
7569      memcpy(&d->arg1,a,sizeof(sleftv));
7570      //a->Init();
7571      d->op=op;
7572      d->argc=1;
7573      res->data=(char *)d;
7574      res->rtyp=COMMAND;
7575      return FALSE;
7576    }
7577#endif
7578    int at=a->Typ();
7579    if (at>MAX_TOK)
7580    {
7581      blackbox *bb=getBlackboxStuff(at);
7582      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7583      else          return TRUE;
7584    }
7585
7586    BOOLEAN failed=FALSE;
7587    iiOp=op;
7588    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7589    int ti = i;
7590    while (dArith1[i].cmd==op)
7591    {
7592      if (at==dArith1[i].arg)
7593      {
7594        int r=res->rtyp=dArith1[i].res;
7595        if (currRing!=NULL)
7596        {
7597          if (check_valid(dArith1[i].valid_for,op)) break;
7598        }
7599        if (TEST_V_ALLWARN)
7600          Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at));
7601        if (r<0)
7602        {
7603          res->rtyp=-r;
7604          #ifdef PROC_BUG
7605          dArith1[i].p(res,a);
7606          #else
7607          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7608          #endif
7609        }
7610        else if ((call_failed=dArith1[i].p(res,a)))
7611        {
7612          break;// leave loop, goto error handling
7613        }
7614        if (a->Next()!=NULL)
7615        {
7616          res->next=(leftv)omAllocBin(sleftv_bin);
7617          failed=iiExprArith1(res->next,a->next,op);
7618        }
7619        a->CleanUp();
7620        return failed;
7621      }
7622      i++;
7623    }
7624    // implicite type conversion --------------------------------------------
7625    if (dArith1[i].cmd!=op)
7626    {
7627      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7628      i=ti;
7629      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7630      while (dArith1[i].cmd==op)
7631      {
7632        int ai;
7633        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7634        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7635        {
7636          int r=res->rtyp=dArith1[i].res;
7637          if (currRing!=NULL)
7638          {
7639            if (check_valid(dArith1[i].valid_for,op)) break;
7640          }
7641          if (r<0)
7642          {
7643            res->rtyp=-r;
7644            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7645            if (!failed)
7646            {
7647              #ifdef PROC_BUG
7648              dArith1[i].p(res,a);
7649              #else
7650              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
7651              #endif
7652            }
7653          }
7654          else
7655          {
7656            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
7657            || (call_failed=dArith1[i].p(res,an)));
7658          }
7659          // everything done, clean up temp. variables
7660          if (failed)
7661          {
7662            // leave loop, goto error handling
7663            break;
7664          }
7665          else
7666          {
7667            if (TEST_V_ALLWARN)
7668              Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp));
7669            if (an->Next() != NULL)
7670            {
7671              res->next = (leftv)omAllocBin(sleftv_bin);
7672              failed=iiExprArith1(res->next,an->next,op);
7673            }
7674            // everything ok, clean up and return
7675            an->CleanUp();
7676            omFreeBin((ADDRESS)an, sleftv_bin);
7677            a->CleanUp();
7678            return failed;
7679          }
7680        }
7681        i++;
7682      }
7683      an->CleanUp();
7684      omFreeBin((ADDRESS)an, sleftv_bin);
7685    }
7686    // error handling
7687    if (!errorreported)
7688    {
7689      if ((at==0) && (a->Fullname()!=sNoName))
7690      {
7691        Werror("`%s` is not defined",a->Fullname());
7692      }
7693      else
7694      {
7695        i=ti;
7696        const char *s = iiTwoOps(op);
7697        Werror("%s(`%s`) failed"
7698                ,s,Tok2Cmdname(at));
7699        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7700        {
7701          while (dArith1[i].cmd==op)
7702          {
7703            if ((dArith1[i].res!=0)
7704            && (dArith1[i].p!=jjWRONG))
7705              Werror("expected %s(`%s`)"
7706                ,s,Tok2Cmdname(dArith1[i].arg));
7707            i++;
7708          }
7709        }
7710      }
7711    }
7712    res->rtyp = UNKNOWN;
7713  }
7714  a->CleanUp();
7715  return TRUE;
7716}
7717
7718/*=================== operations with 3 args. ============================*/
7719/* must be ordered: first operations for chars (infix ops),
7720 * then alphabetically */
7721
7722BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
7723{
7724  memset(res,0,sizeof(sleftv));
7725  BOOLEAN call_failed=FALSE;
7726
7727  if (!errorreported)
7728  {
7729#ifdef SIQ
7730    if (siq>0)
7731    {
7732      //Print("siq:%d\n",siq);
7733      command d=(command)omAlloc0Bin(sip_command_bin);
7734      memcpy(&d->arg1,a,sizeof(sleftv));
7735      //a->Init();
7736      memcpy(&d->arg2,b,sizeof(sleftv));
7737      //b->Init();
7738      memcpy(&d->arg3,c,sizeof(sleftv));
7739      //c->Init();
7740      d->op=op;
7741      d->argc=3;
7742      res->data=(char *)d;
7743      res->rtyp=COMMAND;
7744      return FALSE;
7745    }
7746#endif
7747    int at=a->Typ();
7748    if (at>MAX_TOK)
7749    {
7750      blackbox *bb=getBlackboxStuff(at);
7751      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
7752      else          return TRUE;
7753    }
7754    int bt=b->Typ();
7755    int ct=c->Typ();
7756
7757    iiOp=op;
7758    int i=0;
7759    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7760    while (dArith3[i].cmd==op)
7761    {
7762      if ((at==dArith3[i].arg1)
7763      && (bt==dArith3[i].arg2)
7764      && (ct==dArith3[i].arg3))
7765      {
7766        res->rtyp=dArith3[i].res;
7767        if (currRing!=NULL)
7768        {
7769          if (check_valid(dArith3[i].valid_for,op)) break;
7770        }
7771        if (TEST_V_ALLWARN)
7772          Print("call %s(%s,%s,%s)\n",
7773            Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7774        if ((call_failed=dArith3[i].p(res,a,b,c)))
7775        {
7776          break;// leave loop, goto error handling
7777        }
7778        a->CleanUp();
7779        b->CleanUp();
7780        c->CleanUp();
7781        return FALSE;
7782      }
7783      i++;
7784    }
7785    // implicite type conversion ----------------------------------------------
7786    if (dArith3[i].cmd!=op)
7787    {
7788      int ai,bi,ci;
7789      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7790      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7791      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
7792      BOOLEAN failed=FALSE;
7793      i=0;
7794      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7795      while (dArith3[i].cmd==op)
7796      {
7797        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
7798        {
7799          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
7800          {
7801            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
7802            {
7803              res->rtyp=dArith3[i].res;
7804              if (currRing!=NULL)
7805              {
7806                if (check_valid(dArith3[i].valid_for,op)) break;
7807              }
7808              if (TEST_V_ALLWARN)
7809                Print("call %s(%s,%s,%s)\n",
7810                  Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp),
7811                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
7812              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
7813                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
7814                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
7815                || (call_failed=dArith3[i].p(res,an,bn,cn)));
7816              // everything done, clean up temp. variables
7817              if (failed)
7818              {
7819                // leave loop, goto error handling
7820                break;
7821              }
7822              else
7823              {
7824                // everything ok, clean up and return
7825                an->CleanUp();
7826                bn->CleanUp();
7827                cn->CleanUp();
7828                omFreeBin((ADDRESS)an, sleftv_bin);
7829                omFreeBin((ADDRESS)bn, sleftv_bin);
7830                omFreeBin((ADDRESS)cn, sleftv_bin);
7831                a->CleanUp();
7832                b->CleanUp();
7833                c->CleanUp();
7834        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7835                return FALSE;
7836              }
7837            }
7838          }
7839        }
7840        i++;
7841      }
7842      an->CleanUp();
7843      bn->CleanUp();
7844      cn->CleanUp();
7845      omFreeBin((ADDRESS)an, sleftv_bin);
7846      omFreeBin((ADDRESS)bn, sleftv_bin);
7847      omFreeBin((ADDRESS)cn, sleftv_bin);
7848    }
7849    // error handling ---------------------------------------------------
7850    if (!errorreported)
7851    {
7852      const char *s=NULL;
7853      if ((at==0) && (a->Fullname()!=sNoName))
7854      {
7855        s=a->Fullname();
7856      }
7857      else if ((bt==0) && (b->Fullname()!=sNoName))
7858      {
7859        s=b->Fullname();
7860      }
7861      else if ((ct==0) && (c->Fullname()!=sNoName))
7862      {
7863        s=c->Fullname();
7864      }
7865      if (s!=NULL)
7866        Werror("`%s` is not defined",s);
7867      else
7868      {
7869        i=0;
7870        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7871        const char *s = iiTwoOps(op);
7872        Werror("%s(`%s`,`%s`,`%s`) failed"
7873                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7874        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7875        {
7876          while (dArith3[i].cmd==op)
7877          {
7878            if(((at==dArith3[i].arg1)
7879            ||(bt==dArith3[i].arg2)
7880            ||(ct==dArith3[i].arg3))
7881            && (dArith3[i].res!=0))
7882            {
7883              Werror("expected %s(`%s`,`%s`,`%s`)"
7884                  ,s,Tok2Cmdname(dArith3[i].arg1)
7885                  ,Tok2Cmdname(dArith3[i].arg2)
7886                  ,Tok2Cmdname(dArith3[i].arg3));
7887            }
7888            i++;
7889          }
7890        }
7891      }
7892    }
7893    res->rtyp = UNKNOWN;
7894  }
7895  a->CleanUp();
7896  b->CleanUp();
7897  c->CleanUp();
7898        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7899  return TRUE;
7900}
7901/*==================== operations with many arg. ===============================*/
7902/* must be ordered: first operations for chars (infix ops),
7903 * then alphabetically */
7904
7905BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
7906{
7907  // cnt = 0: all
7908  // cnt = 1: only first one
7909  leftv next;
7910  BOOLEAN failed = TRUE;
7911  if(v==NULL) return failed;
7912  res->rtyp = LIST_CMD;
7913  if(cnt) v->next = NULL;
7914  next = v->next;             // saving next-pointer
7915  failed = jjLIST_PL(res, v);
7916  v->next = next;             // writeback next-pointer
7917  return failed;
7918}
7919
7920BOOLEAN iiExprArithM(leftv res, leftv a, int op)
7921{
7922  memset(res,0,sizeof(sleftv));
7923
7924  if (!errorreported)
7925  {
7926#ifdef SIQ
7927    if (siq>0)
7928    {
7929      //Print("siq:%d\n",siq);
7930      command d=(command)omAlloc0Bin(sip_command_bin);
7931      d->op=op;
7932      res->data=(char *)d;
7933      if (a!=NULL)
7934      {
7935        d->argc=a->listLength();
7936        // else : d->argc=0;
7937        memcpy(&d->arg1,a,sizeof(sleftv));
7938        switch(d->argc)
7939        {
7940          case 3:
7941            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
7942            a->next->next->Init();
7943            /* no break */
7944          case 2:
7945            memcpy(&d->arg2,a->next,sizeof(sleftv));
7946            a->next->Init();
7947            a->next->next=d->arg2.next;
7948            d->arg2.next=NULL;
7949            /* no break */
7950          case 1:
7951            a->Init();
7952            a->next=d->arg1.next;
7953            d->arg1.next=NULL;
7954        }
7955        if (d->argc>3) a->next=NULL;
7956        a->name=NULL;
7957        a->rtyp=0;
7958        a->data=NULL;
7959        a->e=NULL;
7960        a->attribute=NULL;
7961        a->CleanUp();
7962      }
7963      res->rtyp=COMMAND;
7964      return FALSE;
7965    }
7966#endif
7967    if ((a!=NULL) && (a->Typ()>MAX_TOK))
7968    {
7969      blackbox *bb=getBlackboxStuff(a->Typ());
7970      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
7971      else          return TRUE;
7972    }
7973    BOOLEAN failed=FALSE;
7974    int args=0;
7975    if (a!=NULL) args=a->listLength();
7976
7977    iiOp=op;
7978    int i=0;
7979    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
7980    while (dArithM[i].cmd==op)
7981    {
7982      if ((args==dArithM[i].number_of_args)
7983      || (dArithM[i].number_of_args==-1)
7984      || ((dArithM[i].number_of_args==-2)&&(args>0)))
7985      {
7986        res->rtyp=dArithM[i].res;
7987        if (currRing!=NULL)
7988        {
7989          if (check_valid(dArithM[i].valid_for,op)) break;
7990        }
7991        if (TEST_V_ALLWARN)
7992          Print("call %s(... (%d args))\n", Tok2Cmdname(iiOp),args);
7993        if (dArithM[i].p(res,a))
7994        {
7995          break;// leave loop, goto error handling
7996        }
7997        if (a!=NULL) a->CleanUp();
7998        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7999        return failed;
8000      }
8001      i++;
8002    }
8003    // error handling
8004    if (!errorreported)
8005    {
8006      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8007      {
8008        Werror("`%s` is not defined",a->Fullname());
8009      }
8010      else
8011      {
8012        const char *s = iiTwoOps(op);
8013        Werror("%s(...) failed",s);
8014      }
8015    }
8016    res->rtyp = UNKNOWN;
8017  }
8018  if (a!=NULL) a->CleanUp();
8019        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8020  return TRUE;
8021}
8022
8023/*=================== general utilities ============================*/
8024int IsCmd(const char *n, int & tok)
8025{
8026  int i;
8027  int an=1;
8028  int en=sArithBase.nLastIdentifier;
8029
8030  loop
8031  //for(an=0; an<sArithBase.nCmdUsed; )
8032  {
8033    if(an>=en-1)
8034    {
8035      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8036      {
8037        i=an;
8038        break;
8039      }
8040      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8041      {
8042        i=en;
8043        break;
8044      }
8045      else
8046      {
8047        // -- blackbox extensions:
8048        // return 0;
8049        return blackboxIsCmd(n,tok);
8050      }
8051    }
8052    i=(an+en)/2;
8053    if (*n < *(sArithBase.sCmds[i].name))
8054    {
8055      en=i-1;
8056    }
8057    else if (*n > *(sArithBase.sCmds[i].name))
8058    {
8059      an=i+1;
8060    }
8061    else
8062    {
8063      int v=strcmp(n,sArithBase.sCmds[i].name);
8064      if(v<0)
8065      {
8066        en=i-1;
8067      }
8068      else if(v>0)
8069      {
8070        an=i+1;
8071      }
8072      else /*v==0*/
8073      {
8074        break;
8075      }
8076    }
8077  }
8078  lastreserved=sArithBase.sCmds[i].name;
8079  tok=sArithBase.sCmds[i].tokval;
8080  if(sArithBase.sCmds[i].alias==2)
8081  {
8082    Warn("outdated identifier `%s` used - please change your code",
8083    sArithBase.sCmds[i].name);
8084    sArithBase.sCmds[i].alias=1;
8085  }
8086  if (currRingHdl==NULL)
8087  {
8088    #ifdef SIQ
8089    if (siq<=0)
8090    {
8091    #endif
8092      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8093      {
8094        WerrorS("no ring active");
8095        return 0;
8096      }
8097    #ifdef SIQ
8098    }
8099    #endif
8100  }
8101  if (!expected_parms)
8102  {
8103    switch (tok)
8104    {
8105      case IDEAL_CMD:
8106      case INT_CMD:
8107      case INTVEC_CMD:
8108      case MAP_CMD:
8109      case MATRIX_CMD:
8110      case MODUL_CMD:
8111      case POLY_CMD:
8112      case PROC_CMD:
8113      case RING_CMD:
8114      case STRING_CMD:
8115        cmdtok = tok;
8116        break;
8117    }
8118  }
8119  return sArithBase.sCmds[i].toktype;
8120}
8121static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8122{
8123  int a=0;
8124  int e=len;
8125  int p=len/2;
8126  do
8127  {
8128     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8129     if (op<dArithTab[p].cmd) e=p-1;
8130     else   a = p+1;
8131     p=a+(e-a)/2;
8132  }
8133  while ( a <= e);
8134
8135  assume(0);
8136  return 0;
8137}
8138
8139const char * Tok2Cmdname(int tok)
8140{
8141  int i = 0;
8142  if (tok <= 0)
8143  {
8144    return sArithBase.sCmds[0].name;
8145  }
8146  if (tok==ANY_TYPE) return "any_type";
8147  if (tok==COMMAND) return "command";
8148  if (tok==NONE) return "nothing";
8149  //if (tok==IFBREAK) return "if_break";
8150  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8151  //if (tok==ORDER_VECTOR) return "ordering";
8152  //if (tok==REF_VAR) return "ref";
8153  //if (tok==OBJECT) return "object";
8154  //if (tok==PRINT_EXPR) return "print_expr";
8155  if (tok==IDHDL) return "identifier";
8156  if (tok>MAX_TOK) return getBlackboxName(tok);
8157  for(i=0; i<sArithBase.nCmdUsed; i++)
8158    //while (sArithBase.sCmds[i].tokval!=0)
8159  {
8160    if ((sArithBase.sCmds[i].tokval == tok)&&
8161        (sArithBase.sCmds[i].alias==0))
8162    {
8163      return sArithBase.sCmds[i].name;
8164    }
8165  }
8166  return sArithBase.sCmds[0].name;
8167}
8168
8169
8170/*---------------------------------------------------------------------*/
8171/**
8172 * @brief compares to entry of cmdsname-list
8173
8174 @param[in] a
8175 @param[in] b
8176
8177 @return <ReturnValue>
8178**/
8179/*---------------------------------------------------------------------*/
8180static int _gentable_sort_cmds( const void *a, const void *b )
8181{
8182  cmdnames *pCmdL = (cmdnames*)a;
8183  cmdnames *pCmdR = (cmdnames*)b;
8184
8185  if(a==NULL || b==NULL)             return 0;
8186
8187  /* empty entries goes to the end of the list for later reuse */
8188  if(pCmdL->name==NULL) return 1;
8189  if(pCmdR->name==NULL) return -1;
8190
8191  /* $INVALID$ must come first */
8192  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8193  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8194
8195  /* tokval=-1 are reserved names at the end */
8196  if (pCmdL->tokval==-1)
8197  {
8198    if (pCmdR->tokval==-1)
8199       return strcmp(pCmdL->name, pCmdR->name);
8200    /* pCmdL->tokval==-1, pCmdL goes at the end */
8201    return 1;
8202  }
8203  /* pCmdR->tokval==-1, pCmdR goes at the end */
8204  if(pCmdR->tokval==-1) return -1;
8205
8206  return strcmp(pCmdL->name, pCmdR->name);
8207}
8208
8209/*---------------------------------------------------------------------*/
8210/**
8211 * @brief initialisation of arithmetic structured data
8212
8213 @retval 0 on success
8214
8215**/
8216/*---------------------------------------------------------------------*/
8217int iiInitArithmetic()
8218{
8219  int i;
8220  //printf("iiInitArithmetic()\n");
8221  memset(&sArithBase, 0, sizeof(sArithBase));
8222  iiInitCmdName();
8223  /* fix last-identifier */
8224#if 0
8225  /* we expect that gentable allready did every thing */
8226  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8227      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8228    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8229  }
8230#endif
8231  //Print("L=%d\n", sArithBase.nLastIdentifier);
8232
8233  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8234  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8235
8236  //iiArithAddCmd("Top", 0,-1,0);
8237
8238
8239  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8240  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8241  //         sArithBase.sCmds[i].name,
8242  //         sArithBase.sCmds[i].alias,
8243  //         sArithBase.sCmds[i].tokval,
8244  //         sArithBase.sCmds[i].toktype);
8245  //}
8246  //iiArithRemoveCmd("Top");
8247  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8248  //iiArithRemoveCmd("mygcd");
8249  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8250  return 0;
8251}
8252
8253/*---------------------------------------------------------------------*/
8254/**
8255 * @brief append newitem of size sizeofitem to the list named list.
8256
8257 @param[in,out] list
8258 @param[in,out] item_count
8259 @param[in] sizeofitem
8260 @param[in] newitem
8261
8262 @retval  0 success
8263 @retval -1 failure
8264**/
8265/*---------------------------------------------------------------------*/
8266int iiArithAddItem2list(
8267  void **list,
8268  long  *item_count,
8269  long sizeofitem,
8270  void *newitem
8271  )
8272{
8273  int count = *item_count;
8274
8275  //TRACE(0, "add_item_to_list(%p, %p, %ld, %p)\n", list, item_count,
8276  //       sizeofitem, newitem);
8277
8278  if(count==0)
8279  {
8280    *list = (void *)omAlloc(sizeofitem);
8281  }
8282  else
8283  {
8284    *list = (void *)omRealloc(*list, (count+1) * sizeofitem);
8285  }
8286  if((*list)==NULL) return -1;
8287
8288  //memset((*list)+count*sizeofitem, 0, sizeofitem);
8289  //memcpy((*list)+count*sizeofitem, newitem, sizeofitem);
8290
8291  /* erhoehe counter um 1 */
8292  (count)++;
8293  *item_count = count;
8294  return 0;
8295}
8296
8297int iiArithFindCmd(const char *szName)
8298{
8299  int an=0;
8300  int i = 0,v = 0;
8301  int en=sArithBase.nLastIdentifier;
8302
8303  loop
8304  //for(an=0; an<sArithBase.nCmdUsed; )
8305  {
8306    if(an>=en-1)
8307    {
8308      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8309      {
8310        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8311        return an;
8312      }
8313      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8314      {
8315        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8316        return en;
8317      }
8318      else
8319      {
8320        //Print("RET- 1\n");
8321        return -1;
8322      }
8323    }
8324    i=(an+en)/2;
8325    if (*szName < *(sArithBase.sCmds[i].name))
8326    {
8327      en=i-1;
8328    }
8329    else if (*szName > *(sArithBase.sCmds[i].name))
8330    {
8331      an=i+1;
8332    }
8333    else
8334    {
8335      v=strcmp(szName,sArithBase.sCmds[i].name);
8336      if(v<0)
8337      {
8338        en=i-1;
8339      }
8340      else if(v>0)
8341      {
8342        an=i+1;
8343      }
8344      else /*v==0*/
8345      {
8346        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8347        return i;
8348      }
8349    }
8350  }
8351  //if(i>=0 && i<sArithBase.nCmdUsed)
8352  //  return i;
8353  //Print("RET-2\n");
8354  return -2;
8355}
8356
8357char *iiArithGetCmd( int nPos )
8358{
8359  if(nPos<0) return NULL;
8360  if(nPos<sArithBase.nCmdUsed)
8361    return sArithBase.sCmds[nPos].name;
8362  return NULL;
8363}
8364
8365int iiArithRemoveCmd(const char *szName)
8366{
8367  int nIndex;
8368  if(szName==NULL) return -1;
8369
8370  nIndex = iiArithFindCmd(szName);
8371  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8372  {
8373    Print("'%s' not found (%d)\n", szName, nIndex);
8374    return -1;
8375  }
8376  omFree(sArithBase.sCmds[nIndex].name);
8377  sArithBase.sCmds[nIndex].name=NULL;
8378  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8379        (&_gentable_sort_cmds));
8380  sArithBase.nCmdUsed--;
8381
8382  /* fix last-identifier */
8383  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8384      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8385  {
8386    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8387  }
8388  //Print("L=%d\n", sArithBase.nLastIdentifier);
8389  return 0;
8390}
8391
8392int iiArithAddCmd(
8393  const char *szName,
8394  short nAlias,
8395  short nTokval,
8396  short nToktype,
8397  short nPos
8398  )
8399{
8400  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8401  //       nTokval, nToktype, nPos);
8402  if(nPos>=0)
8403  {
8404    // no checks: we rely on a correct generated code in iparith.inc
8405    assume(nPos < sArithBase.nCmdAllocated);
8406    assume(szName!=NULL);
8407    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8408    sArithBase.sCmds[nPos].alias   = nAlias;
8409    sArithBase.sCmds[nPos].tokval  = nTokval;
8410    sArithBase.sCmds[nPos].toktype = nToktype;
8411    sArithBase.nCmdUsed++;
8412    //if(nTokval>0) sArithBase.nLastIdentifier++;
8413  }
8414  else
8415  {
8416    if(szName==NULL) return -1;
8417    int nIndex = iiArithFindCmd(szName);
8418    if(nIndex>=0)
8419    {
8420      Print("'%s' already exists at %d\n", szName, nIndex);
8421      return -1;
8422    }
8423
8424    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8425    {
8426      /* needs to create new slots */
8427      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8428      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8429      if(sArithBase.sCmds==NULL) return -1;
8430      sArithBase.nCmdAllocated++;
8431    }
8432    /* still free slots available */
8433    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8434    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8435    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8436    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8437    sArithBase.nCmdUsed++;
8438
8439    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8440          (&_gentable_sort_cmds));
8441    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8442        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8443    {
8444      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8445    }
8446    //Print("L=%d\n", sArithBase.nLastIdentifier);
8447  }
8448  return 0;
8449}
8450
8451static BOOLEAN check_valid(const int p, const int op)
8452{
8453  #ifdef HAVE_PLURAL
8454  if (rIsPluralRing(currRing))
8455  {
8456    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8457    {
8458      WerrorS("not implemented for non-commutative rings");
8459      return TRUE;
8460    }
8461    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8462    {
8463      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8464      return FALSE;
8465    }
8466    /* else, ALLOW_PLURAL */
8467  }
8468  #endif
8469  #ifdef HAVE_RINGS
8470  if (rField_is_Ring(currRing))
8471  {
8472    if ((p & RING_MASK)==0 /*NO_RING*/)
8473    {
8474      WerrorS("not implemented for rings with rings as coeffients");
8475      return TRUE;
8476    }
8477    /* else ALLOW_RING */
8478    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8479    &&(!rField_is_Domain(currRing)))
8480    {
8481      WerrorS("domain required as coeffients");
8482      return TRUE;
8483    }
8484    /* else ALLOW_ZERODIVISOR */
8485  }
8486  #endif
8487  return FALSE;
8488}
Note: See TracBrowser for help on using the repository browser.