source: git/Singular/iparith.cc @ 91b031

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