source: git/Singular/iparith.cc @ fd1b0f2

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