source: git/Singular/iparith.cc @ cf29d0c

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