source: git/Singular/iparith.cc @ 0c2f6d

spielwiese
Last change on this file since 0c2f6d was 0c2f6d, checked in by Frank Seelisch <seelisch@…>, 12 years ago
removed further assume violations git-svn-id: file:///usr/local/Singular/svn/trunk@13965 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 203.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: table driven kernel interface, used by interpreter
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <ctype.h>
13#include <stdio.h>
14#include <time.h>
15#include <unistd.h>
16
17#include <kernel/mod2.h>
18#include <Singular/tok.h>
19#include <kernel/options.h>
20#include <Singular/ipid.h>
21#include <kernel/intvec.h>
22#include <omalloc/omalloc.h>
23#include <kernel/polys.h>
24#include <kernel/febase.h>
25#include <Singular/sdb.h>
26#include <kernel/longalg.h>
27#include <kernel/longtrans.h>
28#include <kernel/ideals.h>
29#include <kernel/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  intvec *c=(intvec*)u->Data();
1505  intvec* p=(intvec*)v->Data();
1506  int rl=p->length();
1507  number *x=(number *)omAlloc(rl*sizeof(number));
1508  number *q=(number *)omAlloc(rl*sizeof(number));
1509  int i;
1510  for(i=rl-1;i>=0;i--)
1511  {
1512    q[i]=nlInit((*p)[i], NULL);
1513    x[i]=nlInit((*c)[i], NULL);
1514  }
1515  number n=nlChineseRemainder(x,q,rl);
1516  for(i=rl-1;i>=0;i--)
1517  {
1518    nlDelete(&(q[i]),NULL);
1519    nlDelete(&(x[i]),NULL);
1520  }
1521  omFree(x); omFree(q);
1522  res->data=(char *)n;
1523  return FALSE;
1524}
1525#endif
1526#if 0
1527static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1528{
1529  lists c=(lists)u->CopyD(); // list of poly
1530  intvec* p=(intvec*)v->Data();
1531  int rl=p->length();
1532  poly r=NULL,h, result=NULL;
1533  number *x=(number *)omAlloc(rl*sizeof(number));
1534  number *q=(number *)omAlloc(rl*sizeof(number));
1535  int i;
1536  for(i=rl-1;i>=0;i--)
1537  {
1538    q[i]=nlInit((*p)[i]);
1539  }
1540  loop
1541  {
1542    for(i=rl-1;i>=0;i--)
1543    {
1544      if (c->m[i].Typ()!=POLY_CMD)
1545      {
1546        Werror("poly expected at pos %d",i+1);
1547        for(i=rl-1;i>=0;i--)
1548        {
1549          nlDelete(&(q[i]),currRing);
1550        }
1551        omFree(x); omFree(q); // delete c
1552        return TRUE;
1553      }
1554      h=((poly)c->m[i].Data());
1555      if (r==NULL) r=h;
1556      else if (pLmCmp(r,h)==-1) r=h;
1557    }
1558    if (r==NULL) break;
1559    for(i=rl-1;i>=0;i--)
1560    {
1561      h=((poly)c->m[i].Data());
1562      if (pLmCmp(r,h)==0)
1563      {
1564        x[i]=pGetCoeff(h);
1565        h=pLmFreeAndNext(h);
1566        c->m[i].data=(char*)h;
1567      }
1568      else
1569        x[i]=nlInit(0);
1570    }
1571    number n=nlChineseRemainder(x,q,rl);
1572    for(i=rl-1;i>=0;i--)
1573    {
1574      nlDelete(&(x[i]),currRing);
1575    }
1576    h=pHead(r);
1577    pSetCoeff(h,n);
1578    result=pAdd(result,h);
1579  }
1580  for(i=rl-1;i>=0;i--)
1581  {
1582    nlDelete(&(q[i]),currRing);
1583  }
1584  omFree(x); omFree(q);
1585  res->data=(char *)result;
1586  return FALSE;
1587}
1588#endif
1589#ifdef HAVE_FACTORY
1590static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1591{
1592  if ((currRing==NULL) || rField_is_Q())
1593  {
1594    lists c=(lists)u->CopyD(); // list of ideal
1595    lists pl=NULL;
1596    intvec *p=NULL;
1597    if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1598    else                    p=(intvec*)v->Data();
1599    int rl=c->nr+1;
1600    poly r=NULL,h;
1601    ideal result;
1602    ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1603    int i;
1604    int return_type=c->m[0].Typ();
1605    if ((return_type!=IDEAL_CMD)
1606    && (return_type!=MODUL_CMD)
1607    && (return_type!=MATRIX_CMD))
1608    {
1609      WerrorS("ideal/module/matrix expected");
1610      omFree(x); // delete c
1611      return TRUE;
1612    }
1613    for(i=rl-1;i>=0;i--)
1614    {
1615      if (c->m[i].Typ()!=return_type)
1616      {
1617        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1618        omFree(x); // delete c
1619        return TRUE;
1620      }
1621      x[i]=((ideal)c->m[i].Data());
1622    }
1623    number *q=(number *)omAlloc(rl*sizeof(number));
1624    if (p!=NULL)
1625    {
1626      for(i=rl-1;i>=0;i--)
1627      {
1628        q[i]=nlInit((*p)[i], currRing);
1629      }
1630    }
1631    else
1632    {
1633      for(i=rl-1;i>=0;i--)
1634      {
1635        if (pl->m[i].Typ()==INT_CMD)
1636        {
1637          q[i]=nlInit((int)(long)pl->m[i].Data(),currRing);
1638        }
1639        else if (pl->m[i].Typ()==BIGINT_CMD)
1640        {
1641          q[i]=nlCopy((number)(pl->m[i].Data()));
1642        }
1643        else
1644        {
1645          Werror("bigint expected at pos %d",i+1);
1646          for(i++;i<rl;i++)
1647          {
1648            nlDelete(&(q[i]),currRing);
1649          }
1650          omFree(x); // delete c
1651          omFree(q); // delete pl
1652          return TRUE;
1653        }
1654      }
1655    }
1656    result=idChineseRemainder(x,q,rl);
1657    for(i=rl-1;i>=0;i--)
1658    {
1659      nlDelete(&(q[i]),currRing);
1660    }
1661    omFree(q);
1662    res->data=(char *)result;
1663    res->rtyp=return_type;
1664    return FALSE;
1665  }
1666  else return TRUE;
1667}
1668#endif
1669static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1670{
1671  poly p=(poly)v->Data();
1672  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1673  res->data=(char *)mpCoeffProc((poly)u->Data(),p /*(poly)v->Data()*/);
1674  return FALSE;
1675}
1676static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1677{
1678  int i=pVar((poly)v->Data());
1679  if (i==0)
1680  {
1681    WerrorS("ringvar expected");
1682    return TRUE;
1683  }
1684  res->data=(char *)mpCoeffs((ideal)u->CopyD(),i);
1685  return FALSE;
1686}
1687static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1688{
1689  poly p = pInit();
1690  int i;
1691  for (i=1; i<=pVariables; i++)
1692  {
1693    pSetExp(p, i, 1);
1694  }
1695  pSetm(p);
1696  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1697                                    (ideal)(v->Data()), p);
1698  pDelete(&p);
1699  return FALSE;
1700}
1701static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1702{
1703  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1704  return FALSE;
1705}
1706static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1707{
1708  short *iv=iv2array((intvec *)v->Data());
1709  ideal I=(ideal)u->Data();
1710  int d=-1;
1711  int i;
1712  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1713  omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1714  res->data = (char *)((long)d);
1715  return FALSE;
1716}
1717static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1718{
1719  poly p=(poly)u->Data();
1720  if (p!=NULL)
1721  {
1722    short *iv=iv2array((intvec *)v->Data());
1723    int d=(int)pDegW(p,iv);
1724    omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1725    res->data = (char *)(long(d));
1726  }
1727  else
1728    res->data=(char *)(long)(-1);
1729  return FALSE;
1730}
1731static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1732{
1733  int i=pVar((poly)v->Data());
1734  if (i==0)
1735  {
1736    WerrorS("ringvar expected");
1737    return TRUE;
1738  }
1739  res->data=(char *)pDiff((poly)(u->Data()),i);
1740  return FALSE;
1741}
1742static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1743{
1744  int i=pVar((poly)v->Data());
1745  if (i==0)
1746  {
1747    WerrorS("ringvar expected");
1748    return TRUE;
1749  }
1750  res->data=(char *)idDiff((matrix)(u->Data()),i);
1751  return FALSE;
1752}
1753static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1754{
1755  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1756  return FALSE;
1757}
1758static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1759{
1760  assumeStdFlag(v);
1761  if(currQuotient==NULL)
1762    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1763  else
1764  {
1765    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1766    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1767    idDelete(&q);
1768  }
1769  return FALSE;
1770}
1771static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1772{
1773  ideal vi=(ideal)v->Data();
1774  int vl= IDELEMS(vi);
1775  ideal ui=(ideal)u->Data();
1776  int ul= IDELEMS(ui);
1777  ideal R; matrix U;
1778  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1779  // now make sure that all matices have the corect size:
1780  matrix T = idModule2formatedMatrix(m,vl,ul);
1781  int i;
1782  if (MATCOLS(U) != ul)
1783  {
1784    int mul=si_min(ul,MATCOLS(U));
1785    matrix UU=mpNew(ul,ul);
1786    int j;
1787    for(i=mul;i>0;i--)
1788    {
1789      for(j=mul;j>0;j--)
1790      {
1791        MATELEM(UU,i,j)=MATELEM(U,i,j);
1792        MATELEM(U,i,j)=NULL;
1793      }
1794    }
1795    idDelete((ideal *)&U);
1796    U=UU;
1797  }
1798  // make sure that U is a diagonal matrix of units
1799  for(i=ul;i>0;i--)
1800  {
1801    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1802  }
1803  lists L=(lists)omAllocBin(slists_bin);
1804  L->Init(3);
1805  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1806  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1807  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1808  res->data=(char *)L;
1809  return FALSE;
1810}
1811static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1812{
1813  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1814  //setFlag(res,FLAG_STD);
1815  return FALSE;
1816}
1817static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1818{
1819  poly p=pOne();
1820  intvec *iv=(intvec*)v->Data();
1821  for(int i=iv->length()-1; i>=0; i--)
1822  {
1823    pSetExp(p,(*iv)[i],1);
1824  }
1825  pSetm(p);
1826  res->data=(char *)idElimination((ideal)u->Data(),p);
1827  pLmDelete(&p);
1828  //setFlag(res,FLAG_STD);
1829  return FALSE;
1830}
1831static BOOLEAN jjEXPORTTO(leftv res, leftv u, leftv v)
1832{
1833  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1834  return iiExport(v,0,(idhdl)u->data);
1835}
1836static BOOLEAN jjERROR(leftv res, leftv u)
1837{
1838  WerrorS((char *)u->Data());
1839  extern int inerror;
1840  inerror=3;
1841  return TRUE;
1842}
1843static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1844{
1845  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1846  int p0=ABS(uu),p1=ABS(vv);
1847  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1848
1849  while ( p1!=0 )
1850  {
1851    q=p0 / p1;
1852    r=p0 % p1;
1853    p0 = p1; p1 = r;
1854    r = g0 - g1 * q;
1855    g0 = g1; g1 = r;
1856    r = f0 - f1 * q;
1857    f0 = f1; f1 = r;
1858  }
1859  int a = f0;
1860  int b = g0;
1861  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
1862  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
1863  lists L=(lists)omAllocBin(slists_bin);
1864  L->Init(3);
1865  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
1866  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
1867  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
1868  res->rtyp=LIST_CMD;
1869  res->data=(char *)L;
1870  return FALSE;
1871}
1872#ifdef HAVE_FACTORY
1873static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
1874{
1875  poly r,pa,pb;
1876  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb);
1877  if (ret) return TRUE;
1878  lists L=(lists)omAllocBin(slists_bin);
1879  L->Init(3);
1880  res->data=(char *)L;
1881  L->m[0].data=(void *)r;
1882  L->m[0].rtyp=POLY_CMD;
1883  L->m[1].data=(void *)pa;
1884  L->m[1].rtyp=POLY_CMD;
1885  L->m[2].data=(void *)pb;
1886  L->m[2].rtyp=POLY_CMD;
1887  return FALSE;
1888}
1889extern int singclap_factorize_retry;
1890static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
1891{
1892  intvec *v=NULL;
1893  int sw=(int)(long)dummy->Data();
1894  int fac_sw=sw;
1895  if ((sw<0)||(sw>2)) fac_sw=1;
1896  singclap_factorize_retry=0;
1897  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw);
1898  if (f==NULL)
1899    return TRUE;
1900  switch(sw)
1901  {
1902    case 0:
1903    case 2:
1904    {
1905      lists l=(lists)omAllocBin(slists_bin);
1906      l->Init(2);
1907      l->m[0].rtyp=IDEAL_CMD;
1908      l->m[0].data=(void *)f;
1909      l->m[1].rtyp=INTVEC_CMD;
1910      l->m[1].data=(void *)v;
1911      res->data=(void *)l;
1912      res->rtyp=LIST_CMD;
1913      return FALSE;
1914    }
1915    case 1:
1916      res->data=(void *)f;
1917      return FALSE;
1918    case 3:
1919      {
1920        poly p=f->m[0];
1921        int i=IDELEMS(f);
1922        f->m[0]=NULL;
1923        while(i>1)
1924        {
1925          i--;
1926          p=pMult(p,f->m[i]);
1927          f->m[i]=NULL;
1928        }
1929        res->data=(void *)p;
1930        res->rtyp=POLY_CMD;
1931      }
1932      return FALSE;
1933  }
1934  WerrorS("invalid switch");
1935  return TRUE;
1936}
1937static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
1938{
1939  ideal_list p,h;
1940  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
1941  p=h;
1942  int l=0;
1943  while (p!=NULL) { p=p->next;l++; }
1944  lists L=(lists)omAllocBin(slists_bin);
1945  L->Init(l);
1946  l=0;
1947  while(h!=NULL)
1948  {
1949    L->m[l].data=(char *)h->d;
1950    L->m[l].rtyp=IDEAL_CMD;
1951    p=h->next;
1952    omFreeSize(h,sizeof(*h));
1953    h=p;
1954    l++;
1955  }
1956  res->data=(void *)L;
1957  return FALSE;
1958}
1959#endif /* HAVE_FACTORY */
1960static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
1961{
1962  if (rField_is_Q())
1963  {
1964    number uu=(number)u->Data();
1965    number vv=(number)v->Data();
1966    res->data=(char *)nlFarey(uu,vv);
1967    return FALSE;
1968  }
1969  else return TRUE;
1970}
1971static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
1972{
1973  if (rField_is_Q())
1974  {
1975    ideal uu=(ideal)u->Data();
1976    number vv=(number)v->Data();
1977    res->data=(void*)idFarey(uu,vv);
1978    res->rtyp=u->Typ();
1979    return FALSE;
1980  }
1981  else return TRUE;
1982}
1983static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
1984{
1985  ring r=(ring)u->Data();
1986  idhdl w;
1987  int op=iiOp;
1988  nMapFunc nMap;
1989
1990  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
1991  {
1992    int *perm=NULL;
1993    int *par_perm=NULL;
1994    int par_perm_size=0;
1995    BOOLEAN bo;
1996    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
1997    if ((nMap=nSetMap(r))==NULL)
1998    {
1999      if (rEqual(r,currRing))
2000      {
2001        nMap=nCopy;
2002      }
2003      else
2004      // Allow imap/fetch to be make an exception only for:
2005      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2006            (rField_is_Q() || rField_is_Q_a() ||
2007             (rField_is_Zp() || rField_is_Zp_a())))
2008           ||
2009           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2010            (rField_is_Zp(currRing, rInternalChar(r)) ||
2011             rField_is_Zp_a(currRing, rInternalChar(r)))) )
2012      {
2013        par_perm_size=rPar(r);
2014        BITSET save_test=test;
2015        if ((r->minpoly != NULL) || (r->minideal != NULL))
2016          naSetChar(rInternalChar(r),r);
2017        else ntSetChar(rInternalChar(r),r);
2018        nSetChar(currRing);
2019        test=save_test;
2020      }
2021      else
2022      {
2023        goto err_fetch;
2024      }
2025    }
2026    if ((iiOp!=FETCH_CMD) || (r->N!=pVariables) || (rPar(r)!=rPar(currRing)))
2027    {
2028      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2029      if (par_perm_size!=0)
2030        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2031      op=IMAP_CMD;
2032      if (iiOp==IMAP_CMD)
2033      {
2034        maFindPerm(r->names,       r->N,       r->parameter,        r->P,
2035                   currRing->names,currRing->N,currRing->parameter, currRing->P,
2036                   perm,par_perm, currRing->ch);
2037      }
2038      else
2039      {
2040        int i;
2041        if (par_perm_size!=0)
2042          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2043        for(i=si_min(r->N,pVariables);i>0;i--) perm[i]=i;
2044      }
2045    }
2046    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2047    {
2048      int i;
2049      for(i=0;i<si_min(r->N,pVariables);i++)
2050      {
2051        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2052      }
2053      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2054      {
2055        Print("// par nr %d: %s -> %s\n",
2056              i,r->parameter[i],currRing->parameter[i]);
2057      }
2058    }
2059    sleftv tmpW;
2060    memset(&tmpW,0,sizeof(sleftv));
2061    tmpW.rtyp=IDTYP(w);
2062    tmpW.data=IDDATA(w);
2063    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2064                         perm,par_perm,par_perm_size,nMap)))
2065    {
2066      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2067    }
2068    if (perm!=NULL)
2069      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2070    if (par_perm!=NULL)
2071      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2072    return bo;
2073  }
2074  else
2075  {
2076    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2077  }
2078  return TRUE;
2079err_fetch:
2080  Werror("no identity map from %s",u->Fullname());
2081  return TRUE;
2082}
2083static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2084{
2085  /*4
2086  * look for the substring what in the string where
2087  * return the position of the first char of what in where
2088  * or 0
2089  */
2090  char *where=(char *)u->Data();
2091  char *what=(char *)v->Data();
2092  char *found = strstr(where,what);
2093  if (found != NULL)
2094  {
2095    res->data=(char *)((found-where)+1);
2096  }
2097  /*else res->data=NULL;*/
2098  return FALSE;
2099}
2100static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2101{
2102  res->data=(char *)fractalWalkProc(u,v);
2103  setFlag( res, FLAG_STD );
2104  return FALSE;
2105}
2106static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2107{
2108  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2109  int p0=ABS(uu),p1=ABS(vv);
2110  int r;
2111  while ( p1!=0 )
2112  {
2113    r=p0 % p1;
2114    p0 = p1; p1 = r;
2115  }
2116  res->rtyp=INT_CMD;
2117  res->data=(char *)(long)p0;
2118  return FALSE;
2119}
2120static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2121{
2122  number a=(number) u->Data();
2123  number b=(number) v->Data();
2124  if (nlIsZero(a))
2125  {
2126    if (nlIsZero(b)) res->data=(char *)nlInit(1, NULL);
2127    else             res->data=(char *)nlCopy(b);
2128  }
2129  else
2130  {
2131    if (nlIsZero(b))  res->data=(char *)nlCopy(a);
2132    else res->data=(char *)nlGcd(a, b, NULL);
2133  }
2134  return FALSE;
2135}
2136static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2137{
2138  number a=(number) u->Data();
2139  number b=(number) v->Data();
2140  if (nIsZero(a))
2141  {
2142    if (nIsZero(b)) res->data=(char *)nInit(1);
2143    else            res->data=(char *)nCopy(b);
2144  }
2145  else
2146  {
2147    if (nIsZero(b))  res->data=(char *)nCopy(a);
2148    else res->data=(char *)nGcd(a, b, currRing);
2149  }
2150  return FALSE;
2151}
2152#ifdef HAVE_FACTORY
2153static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2154{
2155  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2156                                 (poly)(v->CopyD(POLY_CMD)));
2157  return FALSE;
2158}
2159#endif /* HAVE_FACTORY */
2160static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2161{
2162  assumeStdFlag(u);
2163  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2164  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2165  switch((int)(long)v->Data())
2166  {
2167    case 1:
2168      res->data=(void *)iv;
2169      return FALSE;
2170    case 2:
2171      res->data=(void *)hSecondSeries(iv);
2172      delete iv;
2173      return FALSE;
2174  }
2175  WerrorS(feNotImplemented);
2176  delete iv;
2177  return TRUE;
2178}
2179static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2180{
2181  int i=pVar((poly)v->Data());
2182  if (i==0)
2183  {
2184    WerrorS("ringvar expected");
2185    return TRUE;
2186  }
2187  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2188  int d=pWTotaldegree(p);
2189  pLmDelete(p);
2190  if (d==1)
2191    res->data = (char *)pHomogen((poly)u->Data(),i);
2192  else
2193    WerrorS("variable must have weight 1");
2194  return (d!=1);
2195}
2196static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2197{
2198  int i=pVar((poly)v->Data());
2199  if (i==0)
2200  {
2201    WerrorS("ringvar expected");
2202    return TRUE;
2203  }
2204  pFDegProc deg;
2205  if (pLexOrder && (currRing->order[0]==ringorder_lp))
2206    deg=p_Totaldegree;
2207   else
2208    deg=pFDeg;
2209  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2210  int d=deg(p,currRing);
2211  pLmDelete(p);
2212  if (d==1)
2213    res->data = (char *)idHomogen((ideal)u->Data(),i);
2214  else
2215    WerrorS("variable must have weight 1");
2216  return (d!=1);
2217}
2218static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2219{
2220  intvec *w=new intvec(rVar(currRing));
2221  intvec *vw=(intvec*)u->Data();
2222  ideal v_id=(ideal)v->Data();
2223  pFDegProc save_FDeg=pFDeg;
2224  pLDegProc save_LDeg=pLDeg;
2225  BOOLEAN save_pLexOrder=pLexOrder;
2226  pLexOrder=FALSE;
2227  kHomW=vw;
2228  kModW=w;
2229  pSetDegProcs(kHomModDeg);
2230  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2231  pLexOrder=save_pLexOrder;
2232  kHomW=NULL;
2233  kModW=NULL;
2234  pRestoreDegProcs(save_FDeg,save_LDeg);
2235  if (w!=NULL) delete w;
2236  return FALSE;
2237}
2238static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2239{
2240  assumeStdFlag(u);
2241  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2242                    currQuotient);
2243  return FALSE;
2244}
2245static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2246{
2247  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2248  setFlag(res,FLAG_STD);
2249  return FALSE;
2250}
2251static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2252{
2253  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2254}
2255static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2256{
2257  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2258  return FALSE;
2259}
2260static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2261{
2262  res->data = (char *)idJet((ideal)u->Data(),(int)(long)v->Data());
2263  return FALSE;
2264}
2265static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2266{
2267  assumeStdFlag(u);
2268  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2269  res->data = (char *)scKBase((int)(long)v->Data(),
2270                              (ideal)(u->Data()),currQuotient, w_u);
2271  if (w_u!=NULL)
2272  {
2273    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2274  }
2275  return FALSE;
2276}
2277static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2278static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2279{
2280  return jjPREIMAGE(res,u,v,NULL);
2281}
2282static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2283{
2284  return mpKoszul(res, u,v);
2285}
2286static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2287{
2288  sleftv h;
2289  memset(&h,0,sizeof(sleftv));
2290  h.rtyp=INT_CMD;
2291  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2292  return mpKoszul(res, u, &h, v);
2293}
2294static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2295{
2296  ideal m;
2297  BITSET save_test=test;
2298  int ul= IDELEMS((ideal)u->Data());
2299  int vl= IDELEMS((ideal)v->Data());
2300  m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD));
2301  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
2302  test=save_test;
2303  return FALSE;
2304}
2305static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2306{
2307  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2308  idhdl h=(idhdl)v->data;
2309  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2310  res->data = (char *)idLiftStd((ideal)u->Data(),
2311                                &(h->data.umatrix),testHomog);
2312  setFlag(res,FLAG_STD); v->flag=0;
2313  return FALSE;
2314}
2315static BOOLEAN jjLOAD2(leftv res, leftv u,leftv v)
2316{
2317  return jjLOAD(res, v,TRUE);
2318}
2319static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2320{
2321  char * s=(char *)u->Data();
2322  if(strcmp(s, "with")==0)
2323    return jjLOAD(res, v, TRUE);
2324  WerrorS("invalid second argument");
2325  WerrorS("load(\"libname\" [,\"with\"]);");
2326  return TRUE;
2327}
2328static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2329{
2330  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2331  tHomog hom=testHomog;
2332  if (w_u!=NULL)
2333  {
2334    w_u=ivCopy(w_u);
2335    hom=isHomog;
2336  }
2337  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2338  if (w_v!=NULL)
2339  {
2340    w_v=ivCopy(w_v);
2341    hom=isHomog;
2342  }
2343  if ((w_u!=NULL) && (w_v==NULL))
2344    w_v=ivCopy(w_u);
2345  if ((w_v!=NULL) && (w_u==NULL))
2346    w_u=ivCopy(w_v);
2347  ideal u_id=(ideal)u->Data();
2348  ideal v_id=(ideal)v->Data();
2349  if (w_u!=NULL)
2350  {
2351     if ((*w_u).compare((w_v))!=0)
2352     {
2353       WarnS("incompatible weights");
2354       delete w_u; w_u=NULL;
2355       hom=testHomog;
2356     }
2357     else
2358     {
2359       if ((!idTestHomModule(u_id,currQuotient,w_v))
2360       || (!idTestHomModule(v_id,currQuotient,w_v)))
2361       {
2362         WarnS("wrong weights");
2363         delete w_u; w_u=NULL;
2364         hom=testHomog;
2365       }
2366     }
2367  }
2368  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2369  if (w_u!=NULL)
2370  {
2371    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2372  }
2373  delete w_v;
2374  return FALSE;
2375}
2376static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2377{
2378  number q=(number)v->Data();
2379  if (nlIsZero(q))
2380  {
2381    WerrorS(ii_div_by_0);
2382    return TRUE;
2383  }
2384  res->data =(char *) nlIntMod((number)u->Data(),q);
2385  return FALSE;
2386}
2387static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2388{
2389  number q=(number)v->Data();
2390  if (nIsZero(q))
2391  {
2392    WerrorS(ii_div_by_0);
2393    return TRUE;
2394  }
2395  res->data =(char *) nIntMod((number)u->Data(),q);
2396  return FALSE;
2397}
2398static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2399static BOOLEAN jjMONITOR1(leftv res, leftv v)
2400{
2401  return jjMONITOR2(res,v,NULL);
2402}
2403static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v)
2404{
2405#if 0
2406  char *opt=(char *)v->Data();
2407  int mode=0;
2408  while(*opt!='\0')
2409  {
2410    if (*opt=='i') mode |= PROT_I;
2411    else if (*opt=='o') mode |= PROT_O;
2412    opt++;
2413  }
2414  monitor((char *)(u->Data()),mode);
2415#else
2416  si_link l=(si_link)u->Data();
2417  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2418  if(strcmp(l->m->type,"ASCII")!=0)
2419  {
2420    Werror("ASCII link required, not `%s`",l->m->type);
2421    slClose(l);
2422    return TRUE;
2423  }
2424  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2425  if ( l->name[0]!='\0') // "" is the stop condition
2426  {
2427    const char *opt;
2428    int mode=0;
2429    if (v==NULL) opt=(const char*)"i";
2430    else         opt=(const char *)v->Data();
2431    while(*opt!='\0')
2432    {
2433      if (*opt=='i') mode |= PROT_I;
2434      else if (*opt=='o') mode |= PROT_O;
2435      opt++;
2436    }
2437    monitor((FILE *)l->data,mode);
2438  }
2439  else
2440    monitor(NULL,0);
2441  return FALSE;
2442#endif
2443}
2444static BOOLEAN jjMONOM(leftv res, leftv v)
2445{
2446  intvec *iv=(intvec *)v->Data();
2447  poly p=pOne();
2448  int i,e;
2449  BOOLEAN err=FALSE;
2450  for(i=si_min(pVariables,iv->length()); i>0; i--)
2451  {
2452    e=(*iv)[i-1];
2453    if (e>=0) pSetExp(p,i,e);
2454    else err=TRUE;
2455  }
2456  if (iv->length()==(pVariables+1))
2457  {
2458    res->rtyp=VECTOR_CMD;
2459    e=(*iv)[pVariables];
2460    if (e>=0) pSetComp(p,e);
2461    else err=TRUE;
2462  }
2463  pSetm(p);
2464  res->data=(char*)p;
2465  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2466  return err;
2467}
2468static BOOLEAN jjNEWSTRUCT2(leftv res, leftv u, leftv v)
2469{
2470  // u: the name of the new type
2471  // v: the elements
2472  newstruct_desc d=newstructFromString((const char *)v->Data());
2473  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2474  return d==NULL;
2475}
2476static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2477{
2478  idhdl h=(idhdl)u->data;
2479  int i=(int)(long)v->Data();
2480  int p=0;
2481  if ((0<i)
2482  && (IDRING(h)->parameter!=NULL)
2483  && (i<=(p=rPar(IDRING(h)))))
2484    res->data=omStrDup(IDRING(h)->parameter[i-1]);
2485  else
2486  {
2487    Werror("par number %d out of range 1..%d",i,p);
2488    return TRUE;
2489  }
2490  return FALSE;
2491}
2492#ifdef HAVE_PLURAL
2493static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2494{
2495  if( currRing->qideal != NULL )
2496  {
2497    WerrorS("basering must NOT be a qring!");
2498    return TRUE;
2499  }
2500
2501  if (iiOp==NCALGEBRA_CMD)
2502  {
2503    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing);
2504  }
2505  else
2506  {
2507    ring r=rCopy(currRing);
2508    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r);
2509    res->data=r;
2510    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2511    return result;
2512  }
2513}
2514static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2515{
2516  if( currRing->qideal != NULL )
2517  {
2518    WerrorS("basering must NOT be a qring!");
2519    return TRUE;
2520  }
2521
2522  if (iiOp==NCALGEBRA_CMD)
2523  {
2524    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing);
2525  }
2526  else
2527  {
2528    ring r=rCopy(currRing);
2529    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r);
2530    res->data=r;
2531    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2532    return result;
2533  }
2534}
2535static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2536{
2537  if( currRing->qideal != NULL )
2538  {
2539    WerrorS("basering must NOT be a qring!");
2540    return TRUE;
2541  }
2542
2543  if (iiOp==NCALGEBRA_CMD)
2544  {
2545    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing);
2546  }
2547  else
2548  {
2549    ring r=rCopy(currRing);
2550    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r);
2551    res->data=r;
2552    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2553    return result;
2554  }
2555}
2556static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2557{
2558  if( currRing->qideal != NULL )
2559  {
2560    WerrorS("basering must NOT be a qring!");
2561    return TRUE;
2562  }
2563
2564  if (iiOp==NCALGEBRA_CMD)
2565  {
2566    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing);
2567  }
2568  else
2569  {
2570    ring r=rCopy(currRing);
2571    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r);
2572    res->data=r;
2573    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2574    return result;
2575  }
2576}
2577static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2578{
2579  res->data=NULL;
2580
2581  if (rIsPluralRing(currRing))
2582  {
2583    const poly q = (poly)b->Data();
2584
2585    if( q != NULL )
2586    {
2587      if( (poly)a->Data() != NULL )
2588      {
2589        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2590        res->data = nc_p_Bracket_qq(p,q); // p will be destroyed!
2591      }
2592    }
2593  }
2594  return FALSE;
2595}
2596static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2597{
2598  /* number, poly, vector, ideal, module, matrix */
2599  ring  r = (ring)a->Data();
2600  if (r == currRing)
2601  {
2602    res->data = b->Data();
2603    res->rtyp = b->rtyp;
2604    return FALSE;
2605  }
2606  if (!rIsLikeOpposite(currRing, r))
2607  {
2608    Werror("%s is not an opposite ring to current ring",a->Fullname());
2609    return TRUE;
2610  }
2611  idhdl w;
2612  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2613  {
2614    int argtype = IDTYP(w);
2615    switch (argtype)
2616    {
2617    case NUMBER_CMD:
2618      {
2619        /* since basefields are equal, we can apply nCopy */
2620        res->data = nCopy((number)IDDATA(w));
2621        res->rtyp = argtype;
2622        break;
2623      }
2624    case POLY_CMD:
2625    case VECTOR_CMD:
2626      {
2627        poly    q = (poly)IDDATA(w);
2628        res->data = pOppose(r,q);
2629        res->rtyp = argtype;
2630        break;
2631      }
2632    case IDEAL_CMD:
2633    case MODUL_CMD:
2634      {
2635        ideal   Q = (ideal)IDDATA(w);
2636        res->data = idOppose(r,Q);
2637        res->rtyp = argtype;
2638        break;
2639      }
2640    case MATRIX_CMD:
2641      {
2642        ring save = currRing;
2643        rChangeCurrRing(r);
2644        matrix  m = (matrix)IDDATA(w);
2645        ideal   Q = idMatrix2Module(mpCopy(m));
2646        rChangeCurrRing(save);
2647        ideal   S = idOppose(r,Q);
2648        id_Delete(&Q, r);
2649        res->data = idModule2Matrix(S);
2650        res->rtyp = argtype;
2651        break;
2652      }
2653    default:
2654      {
2655        WerrorS("unsupported type in oppose");
2656        return TRUE;
2657      }
2658    }
2659  }
2660  else
2661  {
2662    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2663    return TRUE;
2664  }
2665  return FALSE;
2666}
2667#endif /* HAVE_PLURAL */
2668
2669static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2670{
2671  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2672    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2673  idDelMultiples((ideal)(res->data));
2674  return FALSE;
2675}
2676static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2677{
2678  int i=(int)(long)u->Data();
2679  int j=(int)(long)v->Data();
2680  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2681  return FALSE;
2682}
2683static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2684{
2685  matrix m =(matrix)u->Data();
2686  int isRowEchelon = (int)(long)v->Data();
2687  if (isRowEchelon != 1) isRowEchelon = 0;
2688  int rank = luRank(m, isRowEchelon);
2689  res->data =(char *)(long)rank;
2690  return FALSE;
2691}
2692static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2693{
2694  si_link l=(si_link)u->Data();
2695  leftv r=slRead(l,v);
2696  if (r==NULL)
2697  {
2698    const char *s;
2699    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2700    else                            s=sNoName;
2701    Werror("cannot read from `%s`",s);
2702    return TRUE;
2703  }
2704  memcpy(res,r,sizeof(sleftv));
2705  omFreeBin((ADDRESS)r, sleftv_bin);
2706  return FALSE;
2707}
2708static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2709{
2710  assumeStdFlag(v);
2711  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2712  return FALSE;
2713}
2714static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2715{
2716  assumeStdFlag(v);
2717  ideal ui=(ideal)u->Data();
2718  idTest(ui);
2719  ideal vi=(ideal)v->Data();
2720  idTest(vi);
2721  res->data = (char *)kNF(vi,currQuotient,ui);
2722  return FALSE;
2723}
2724#if 0
2725static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2726{
2727  int maxl=(int)(long)v->Data();
2728  if (maxl<0)
2729  {
2730    WerrorS("length for res must not be negative");
2731    return TRUE;
2732  }
2733  int l=0;
2734  //resolvente r;
2735  syStrategy r;
2736  intvec *weights=NULL;
2737  int wmaxl=maxl;
2738  ideal u_id=(ideal)u->Data();
2739
2740  maxl--;
2741  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2742  {
2743    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2744    if (currQuotient!=NULL)
2745    {
2746      Warn(
2747      "full resolution in a qring may be infinite, setting max length to %d",
2748      maxl+1);
2749    }
2750  }
2751  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2752  if (weights!=NULL)
2753  {
2754    if (!idTestHomModule(u_id,currQuotient,weights))
2755    {
2756      WarnS("wrong weights given:");weights->show();PrintLn();
2757      weights=NULL;
2758    }
2759  }
2760  intvec *ww=NULL;
2761  int add_row_shift=0;
2762  if (weights!=NULL)
2763  {
2764     ww=ivCopy(weights);
2765     add_row_shift = ww->min_in();
2766     (*ww) -= add_row_shift;
2767  }
2768  else
2769    idHomModule(u_id,currQuotient,&ww);
2770  weights=ww;
2771
2772  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2773  {
2774    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2775  }
2776  else if (iiOp==SRES_CMD)
2777  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2778    r=sySchreyer(u_id,maxl+1);
2779  else if (iiOp == LRES_CMD)
2780  {
2781    int dummy;
2782    if((currQuotient!=NULL)||
2783    (!idHomIdeal (u_id,NULL)))
2784    {
2785       WerrorS
2786       ("`lres` not implemented for inhomogeneous input or qring");
2787       return TRUE;
2788    }
2789    r=syLaScala3(u_id,&dummy);
2790  }
2791  else if (iiOp == KRES_CMD)
2792  {
2793    int dummy;
2794    if((currQuotient!=NULL)||
2795    (!idHomIdeal (u_id,NULL)))
2796    {
2797       WerrorS
2798       ("`kres` not implemented for inhomogeneous input or qring");
2799       return TRUE;
2800    }
2801    r=syKosz(u_id,&dummy);
2802  }
2803  else
2804  {
2805    int dummy;
2806    if((currQuotient!=NULL)||
2807    (!idHomIdeal (u_id,NULL)))
2808    {
2809       WerrorS
2810       ("`hres` not implemented for inhomogeneous input or qring");
2811       return TRUE;
2812    }
2813    r=syHilb(u_id,&dummy);
2814  }
2815  if (r==NULL) return TRUE;
2816  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2817  r->list_length=wmaxl;
2818  res->data=(void *)r;
2819  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2820  {
2821    intvec *w=ivCopy(r->weights[0]);
2822    if (weights!=NULL) (*w) += add_row_shift;
2823    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
2824    w=NULL;
2825  }
2826  else
2827  {
2828//#if 0
2829// need to set weights for ALL components (sres)
2830    if (weights!=NULL)
2831    {
2832      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2833      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
2834      (r->weights)[0] = ivCopy(weights);
2835    }
2836//#endif
2837  }
2838  if (ww!=NULL) { delete ww; ww=NULL; }
2839  return FALSE;
2840}
2841#else
2842static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2843{
2844  int maxl=(int)(long)v->Data();
2845  if (maxl<0)
2846  {
2847    WerrorS("length for res must not be negative");
2848    return TRUE;
2849  }
2850  int l=0;
2851  //resolvente r;
2852  syStrategy r;
2853  intvec *weights=NULL;
2854  int wmaxl=maxl;
2855  ideal u_id=(ideal)u->Data();
2856
2857  maxl--;
2858  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2859  {
2860    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2861    if (currQuotient!=NULL)
2862    {
2863      Warn(
2864      "full resolution in a qring may be infinite, setting max length to %d",
2865      maxl+1);
2866    }
2867  }
2868  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2869  if (weights!=NULL)
2870  {
2871    if (!idTestHomModule(u_id,currQuotient,weights))
2872    {
2873      WarnS("wrong weights given:");weights->show();PrintLn();
2874      weights=NULL;
2875    }
2876  }
2877  intvec *ww=NULL;
2878  int add_row_shift=0;
2879  if (weights!=NULL)
2880  {
2881     ww=ivCopy(weights);
2882     add_row_shift = ww->min_in();
2883     (*ww) -= add_row_shift;
2884  }
2885  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2886  {
2887    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2888  }
2889  else if (iiOp==SRES_CMD)
2890  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2891    r=sySchreyer(u_id,maxl+1);
2892  else if (iiOp == LRES_CMD)
2893  {
2894    int dummy;
2895    if((currQuotient!=NULL)||
2896    (!idHomIdeal (u_id,NULL)))
2897    {
2898       WerrorS
2899       ("`lres` not implemented for inhomogeneous input or qring");
2900       return TRUE;
2901    }
2902    r=syLaScala3(u_id,&dummy);
2903  }
2904  else if (iiOp == KRES_CMD)
2905  {
2906    int dummy;
2907    if((currQuotient!=NULL)||
2908    (!idHomIdeal (u_id,NULL)))
2909    {
2910       WerrorS
2911       ("`kres` not implemented for inhomogeneous input or qring");
2912       return TRUE;
2913    }
2914    r=syKosz(u_id,&dummy);
2915  }
2916  else
2917  {
2918    int dummy;
2919    if((currQuotient!=NULL)||
2920    (!idHomIdeal (u_id,NULL)))
2921    {
2922       WerrorS
2923       ("`hres` not implemented for inhomogeneous input or qring");
2924       return TRUE;
2925    }
2926    ideal u_id_copy=idCopy(u_id);
2927    idSkipZeroes(u_id_copy);
2928    r=syHilb(u_id_copy,&dummy);
2929    idDelete(&u_id_copy);
2930  }
2931  if (r==NULL) return TRUE;
2932  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2933  r->list_length=wmaxl;
2934  res->data=(void *)r;
2935  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
2936  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2937  {
2938    ww=ivCopy(r->weights[0]);
2939    if (weights!=NULL) (*ww) += add_row_shift;
2940    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
2941  }
2942  else
2943  {
2944    if (weights!=NULL)
2945    {
2946      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2947    }
2948  }
2949  return FALSE;
2950}
2951#endif
2952static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
2953{
2954  number n1; number n2; number temp; int i;
2955
2956  if ((u->Typ() == BIGINT_CMD) ||
2957     ((u->Typ() == NUMBER_CMD) && rField_is_Q()))
2958  {
2959    temp = (number)u->Data();
2960    n1 = nlCopy(temp);
2961  }
2962  else if (u->Typ() == INT_CMD)
2963  {
2964    i = (int)(long)u->Data();
2965    n1 = nlInit(i, NULL);
2966  }
2967  else
2968  {
2969    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
2970    return TRUE;
2971  }
2972
2973  if ((v->Typ() == BIGINT_CMD) ||
2974     ((v->Typ() == NUMBER_CMD) && rField_is_Q()))
2975  {
2976    temp = (number)v->Data();
2977    n2 = nlCopy(temp);
2978  }
2979  else if (v->Typ() == INT_CMD)
2980  {
2981    i = (int)(long)v->Data();
2982    n2 = nlInit(i, NULL);
2983  }
2984  else
2985  {
2986    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
2987    return TRUE;
2988  }
2989
2990  lists l = primeFactorisation(n1, n2);
2991  nlDelete(&n1, NULL); nlDelete(&n2, NULL);
2992  res->data = (char*)l;
2993  return FALSE;
2994}
2995static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
2996{
2997  ring r;
2998  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
2999  res->data = (char *)r;
3000  return (i==-1);
3001}
3002#define SIMPL_LMDIV 32
3003#define SIMPL_LMEQ  16
3004#define SIMPL_MULT 8
3005#define SIMPL_EQU  4
3006#define SIMPL_NULL 2
3007#define SIMPL_NORM 1
3008static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3009{
3010  int sw = (int)(long)v->Data();
3011  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3012  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3013  if (sw & SIMPL_LMDIV)
3014  {
3015    idDelDiv(id);
3016  }
3017  if (sw & SIMPL_LMEQ)
3018  {
3019    idDelLmEquals(id);
3020  }
3021  if (sw & SIMPL_MULT)
3022  {
3023    idDelMultiples(id);
3024  }
3025  else if(sw & SIMPL_EQU)
3026  {
3027    idDelEquals(id);
3028  }
3029  if (sw & SIMPL_NULL)
3030  {
3031    idSkipZeroes(id);
3032  }
3033  if (sw & SIMPL_NORM)
3034  {
3035    idNorm(id);
3036  }
3037  res->data = (char * )id;
3038  return FALSE;
3039}
3040static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3041{
3042  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3043  return FALSE;
3044}
3045static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3046{
3047  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3048  //return (res->data== (void*)(long)-2);
3049  return FALSE;
3050}
3051static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3052{
3053  int sw = (int)(long)v->Data();
3054  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3055  poly p = (poly)u->CopyD(POLY_CMD);
3056  if (sw & SIMPL_NORM)
3057  {
3058    pNorm(p);
3059  }
3060  res->data = (char * )p;
3061  return FALSE;
3062}
3063static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3064{
3065  ideal result;
3066  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3067  tHomog hom=testHomog;
3068  ideal u_id=(ideal)(u->Data());
3069  if (w!=NULL)
3070  {
3071    if (!idTestHomModule(u_id,currQuotient,w))
3072    {
3073      WarnS("wrong weights:");w->show();PrintLn();
3074      w=NULL;
3075    }
3076    else
3077    {
3078      w=ivCopy(w);
3079      hom=isHomog;
3080    }
3081  }
3082  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3083  idSkipZeroes(result);
3084  res->data = (char *)result;
3085  setFlag(res,FLAG_STD);
3086  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3087  return FALSE;
3088}
3089static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3090static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3091/* destroys i0, p0 */
3092/* result (with attributes) in res */
3093/* i0: SB*/
3094/* t0: type of p0*/
3095/* p0 new elements*/
3096/* a attributes of i0*/
3097{
3098  int tp;
3099  if (t0==IDEAL_CMD) tp=POLY_CMD;
3100  else               tp=VECTOR_CMD;
3101  for (int i=IDELEMS(p0)-1; i>=0; i--)
3102  {
3103    poly p=p0->m[i];
3104    p0->m[i]=NULL;
3105    if (p!=NULL)
3106    {
3107      sleftv u0,v0;
3108      memset(&u0,0,sizeof(sleftv));
3109      memset(&v0,0,sizeof(sleftv));
3110      v0.rtyp=tp;
3111      v0.data=(void*)p;
3112      u0.rtyp=t0;
3113      u0.data=i0;
3114      u0.attribute=a;
3115      setFlag(&u0,FLAG_STD);
3116      jjSTD_1(res,&u0,&v0);
3117      i0=(ideal)res->data;
3118      res->data=NULL;
3119      a=res->attribute;
3120      res->attribute=NULL;
3121      u0.CleanUp();
3122      v0.CleanUp();
3123      res->CleanUp();
3124    }
3125  }
3126  idDelete(&p0);
3127  res->attribute=a;
3128  res->data=(void *)i0;
3129  res->rtyp=t0;
3130}
3131static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3132{
3133  ideal result;
3134  assumeStdFlag(u);
3135  ideal i1=(ideal)(u->Data());
3136  ideal i0;
3137  int r=v->Typ();
3138  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3139  {
3140    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3141    i0->m[0]=(poly)v->Data();
3142    int ii0=idElem(i0); /* size of i0 */
3143    i1=idSimpleAdd(i1,i0); //
3144    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3145    idDelete(&i0);
3146    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3147    tHomog hom=testHomog;
3148
3149    if (w!=NULL)
3150    {
3151      if (!idTestHomModule(i1,currQuotient,w))
3152      {
3153        // no warnung: this is legal, if i in std(i,p)
3154        // is homogeneous, but p not
3155        w=NULL;
3156      }
3157      else
3158      {
3159        w=ivCopy(w);
3160        hom=isHomog;
3161      }
3162    }
3163    BITSET save_test=test;
3164    test|=Sy_bit(OPT_SB_1);
3165    /* ii0 appears to be the position of the first element of il that
3166       does not belong to the old SB ideal */
3167    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3168    test=save_test;
3169    idDelete(&i1);
3170    idSkipZeroes(result);
3171    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3172    res->data = (char *)result;
3173  }
3174  else /*IDEAL/MODULE*/
3175  {
3176    attr a=NULL;
3177    if (u->attribute!=NULL) a=u->attribute->Copy();
3178    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3179  }
3180  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3181  return FALSE;
3182}
3183static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3184{
3185  idhdl h=(idhdl)u->data;
3186  int i=(int)(long)v->Data();
3187  if ((0<i) && (i<=IDRING(h)->N))
3188    res->data=omStrDup(IDRING(h)->names[i-1]);
3189  else
3190  {
3191    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3192    return TRUE;
3193  }
3194  return FALSE;
3195}
3196static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3197{
3198// input: u: a list with links of type
3199//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3200//        v: timeout for select in milliseconds
3201//           or 0 for polling
3202// returns: ERROR (via Werror): timeout negative
3203//           -1: the read state of all links is eof
3204//            0: timeout (or polling): none ready
3205//           i>0: (at least) L[i] is ready
3206  lists Lforks = (lists)u->Data();
3207  int t = (int)(long)v->Data();
3208  if(t < 0)
3209  {
3210    WerrorS("negative timeout"); return TRUE;
3211  }
3212  int i = slStatusSsiL(Lforks, t*1000);
3213  if(i == -2) /* error */
3214  {
3215    return TRUE;
3216  }
3217  res->data = (void*)(long)i;
3218  return FALSE;
3219}
3220static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3221{
3222// input: u: a list with links of type
3223//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3224//        v: timeout for select in milliseconds
3225//           or 0 for polling
3226// returns: ERROR (via Werror): timeout negative
3227//           -1: the read state of all links is eof
3228//           0: timeout (or polling): none ready
3229//           1: all links are ready
3230//              (caution: at least one is ready, but some maybe dead)
3231  lists Lforks = (lists)u->CopyD();
3232  int timeout = 1000*(int)(long)v->Data();
3233  if(timeout < 0)
3234  {
3235    WerrorS("negative timeout"); return TRUE;
3236  }
3237  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3238  int i;
3239  int ret = -1;
3240  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3241  {
3242    i = slStatusSsiL(Lforks, timeout);
3243    if(i > 0) /* Lforks[i] is ready */
3244    {
3245      ret = 1;
3246      Lforks->m[i-1].CleanUp();
3247      Lforks->m[i-1].rtyp=DEF_CMD;
3248      Lforks->m[i-1].data=NULL;
3249      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3250    }
3251    else /* terminate the for loop */
3252    {
3253      if(i == -2) /* error */
3254      {
3255        return TRUE;
3256      }
3257      if(i == 0) /* timeout */
3258      {
3259        ret = 0;
3260      }
3261      break;
3262    }
3263  }
3264  Lforks->Clean();
3265  res->data = (void*)(long)ret;
3266  return FALSE;
3267}
3268static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3269{
3270  res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
3271  return FALSE;
3272}
3273#define jjWRONG2 (proc2)jjWRONG
3274#define jjWRONG3 (proc3)jjWRONG
3275static BOOLEAN jjWRONG(leftv res, leftv u)
3276{
3277  return TRUE;
3278}
3279
3280/*=================== operations with 1 arg.: static proc =================*/
3281/* must be ordered: first operations for chars (infix ops),
3282 * then alphabetically */
3283
3284static BOOLEAN jjDUMMY(leftv res, leftv u)
3285{
3286  res->data = (char *)u->CopyD();
3287  return FALSE;
3288}
3289static BOOLEAN jjNULL(leftv res, leftv u)
3290{
3291  return FALSE;
3292}
3293//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3294//{
3295//  res->data = (char *)((int)(long)u->Data()+1);
3296//  return FALSE;
3297//}
3298//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3299//{
3300//  res->data = (char *)((int)(long)u->Data()-1);
3301//  return FALSE;
3302//}
3303static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3304{
3305  if (IDTYP((idhdl)u->data)==INT_CMD)
3306  {
3307    int i=IDINT((idhdl)u->data);
3308    if (iiOp==PLUSPLUS) i++;
3309    else                i--;
3310    IDDATA((idhdl)u->data)=(char *)(long)i;
3311    return FALSE;
3312  }
3313  return TRUE;
3314}
3315static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3316{
3317  number n=(number)u->CopyD(BIGINT_CMD);
3318  n=nlNeg(n);
3319  res->data = (char *)n;
3320  return FALSE;
3321}
3322static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3323{
3324  res->data = (char *)(-(long)u->Data());
3325  return FALSE;
3326}
3327static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3328{
3329  number n=(number)u->CopyD(NUMBER_CMD);
3330  n=nNeg(n);
3331  res->data = (char *)n;
3332  return FALSE;
3333}
3334static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3335{
3336  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3337  return FALSE;
3338}
3339static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3340{
3341  poly m1=pISet(-1);
3342  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
3343  return FALSE;
3344}
3345static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3346{
3347  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3348  (*iv)*=(-1);
3349  res->data = (char *)iv;
3350  return FALSE;
3351}
3352static BOOLEAN jjPROC1(leftv res, leftv u)
3353{
3354  return jjPROC(res,u,NULL);
3355}
3356static BOOLEAN jjBAREISS(leftv res, leftv v)
3357{
3358  //matrix m=(matrix)v->Data();
3359  //lists l=mpBareiss(m,FALSE);
3360  intvec *iv;
3361  ideal m;
3362  smCallBareiss((ideal)v->Data(),0,0,m,&iv);
3363  lists l=(lists)omAllocBin(slists_bin);
3364  l->Init(2);
3365  l->m[0].rtyp=MODUL_CMD;
3366  l->m[1].rtyp=INTVEC_CMD;
3367  l->m[0].data=(void *)m;
3368  l->m[1].data=(void *)iv;
3369  res->data = (char *)l;
3370  return FALSE;
3371}
3372//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3373//{
3374//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3375//  ivTriangMat(m);
3376//  res->data = (char *)m;
3377//  return FALSE;
3378//}
3379static BOOLEAN jjBI2N(leftv res, leftv u)
3380{
3381  if (rField_is_Q())
3382  {
3383    res->data=u->CopyD();
3384    return FALSE;
3385  }
3386  else
3387  {
3388    BOOLEAN bo=FALSE;
3389    number n=(number)u->CopyD();
3390    if (rField_is_Zp())
3391    {
3392      res->data=(void *)npMap0(n);
3393    }
3394    else if (rField_is_Q_a())
3395    {
3396      res->data=(void *)naMap00(n);
3397    }
3398    else if (rField_is_Zp_a())
3399    {
3400      res->data=(void *)naMap0P(n);
3401    }
3402#ifdef HAVE_RINGS
3403    else if (rField_is_Ring_Z())
3404    {
3405      res->data=(void *)nrzMapQ(n);
3406    }
3407    else if (rField_is_Ring_ModN())
3408    {
3409      res->data=(void *)nrnMapQ(n);
3410    }
3411    else if (rField_is_Ring_PtoM())
3412    {
3413      res->data=(void *)nrnMapQ(n);
3414    }
3415    else if (rField_is_Ring_2toM())
3416    {
3417      res->data=(void *)nr2mMapQ(n);
3418    }
3419#endif
3420    else
3421    {
3422      WerrorS("cannot convert bigint to this field");
3423      bo=TRUE;
3424    }
3425    nlDelete(&n,NULL);
3426    return bo;
3427  }
3428}
3429static BOOLEAN jjBI2P(leftv res, leftv u)
3430{
3431  sleftv tmp;
3432  BOOLEAN bo=jjBI2N(&tmp,u);
3433  if (!bo)
3434  {
3435    number n=(number) tmp.data;
3436    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3437    else
3438    {
3439      res->data=(void *)pNSet(n);
3440    }
3441  }
3442  return bo;
3443}
3444static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3445{
3446  return iiExprArithM(res,u,iiOp);
3447}
3448static BOOLEAN jjCHAR(leftv res, leftv v)
3449{
3450  res->data = (char *)(long)rChar((ring)v->Data());
3451  return FALSE;
3452}
3453static BOOLEAN jjCOLS(leftv res, leftv v)
3454{
3455  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3456  return FALSE;
3457}
3458static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3459{
3460  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3461  return FALSE;
3462}
3463static BOOLEAN jjCONTENT(leftv res, leftv v)
3464{
3465  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3466  poly p=(poly)v->CopyD(POLY_CMD);
3467  if (p!=NULL) p_Cleardenom(p, currRing);
3468  res->data = (char *)p;
3469  return FALSE;
3470}
3471static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3472{
3473  res->data = (char *)(long)nlSize((number)v->Data());
3474  return FALSE;
3475}
3476static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3477{
3478  res->data = (char *)(long)nSize((number)v->Data());
3479  return FALSE;
3480}
3481static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3482{
3483  lists l=(lists)v->Data();
3484  res->data = (char *)(long)(l->nr+1);
3485  return FALSE;
3486}
3487static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3488{
3489  matrix m=(matrix)v->Data();
3490  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3491  return FALSE;
3492}
3493static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3494{
3495  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3496  return FALSE;
3497}
3498static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3499{
3500  ring r=(ring)v->Data();
3501  int elems=-1;
3502  if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
3503  else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
3504  {
3505#ifdef HAVE_FACTORY
3506    extern int ipower ( int b, int n ); /* factory/cf_util */
3507    elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
3508#else
3509    elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
3510#endif
3511  }
3512  res->data = (char *)(long)elems;
3513  return FALSE;
3514}
3515static BOOLEAN jjDEG(leftv res, leftv v)
3516{
3517  int dummy;
3518  poly p=(poly)v->Data();
3519  if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
3520  else res->data=(char *)-1;
3521  return FALSE;
3522}
3523static BOOLEAN jjDEG_M(leftv res, leftv u)
3524{
3525  ideal I=(ideal)u->Data();
3526  int d=-1;
3527  int dummy;
3528  int i;
3529  for(i=IDELEMS(I)-1;i>=0;i--)
3530    if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
3531  res->data = (char *)(long)d;
3532  return FALSE;
3533}
3534static BOOLEAN jjDEGREE(leftv res, leftv v)
3535{
3536  assumeStdFlag(v);
3537  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3538  scDegree((ideal)v->Data(),module_w,currQuotient);
3539  return FALSE;
3540}
3541static BOOLEAN jjDEFINED(leftv res, leftv v)
3542{
3543  if ((v->rtyp==IDHDL)
3544  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3545  {
3546    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3547  }
3548  else if (v->rtyp!=0) res->data=(void *)(-1);
3549  return FALSE;
3550}
3551#ifdef HAVE_FACTORY
3552static BOOLEAN jjDET(leftv res, leftv v)
3553{
3554  matrix m=(matrix)v->Data();
3555  poly p;
3556  if (smCheckDet((ideal)m,m->cols(),TRUE))
3557  {
3558    ideal I=idMatrix2Module(mpCopy(m));
3559    p=smCallDet(I);
3560    idDelete(&I);
3561  }
3562  else
3563    p=singclap_det(m);
3564  res ->data = (char *)p;
3565  return FALSE;
3566}
3567static BOOLEAN jjDET_I(leftv res, leftv v)
3568{
3569  intvec * m=(intvec*)v->Data();
3570  int i,j;
3571  i=m->rows();j=m->cols();
3572  if(i==j)
3573    res->data = (char *)(long)singclap_det_i(m);
3574  else
3575  {
3576    Werror("det of %d x %d intmat",i,j);
3577    return TRUE;
3578  }
3579  return FALSE;
3580}
3581static BOOLEAN jjDET_S(leftv res, leftv v)
3582{
3583  ideal I=(ideal)v->Data();
3584  poly p;
3585  if (IDELEMS(I)<1) return TRUE;
3586  if (smCheckDet(I,IDELEMS(I),FALSE))
3587  {
3588    matrix m=idModule2Matrix(idCopy(I));
3589    p=singclap_det(m);
3590    idDelete((ideal *)&m);
3591  }
3592  else
3593    p=smCallDet(I);
3594  res->data = (char *)p;
3595  return FALSE;
3596}
3597#endif
3598static BOOLEAN jjDIM(leftv res, leftv v)
3599{
3600  assumeStdFlag(v);
3601  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3602  return FALSE;
3603}
3604static BOOLEAN jjDUMP(leftv res, leftv v)
3605{
3606  si_link l = (si_link)v->Data();
3607  if (slDump(l))
3608  {
3609    const char *s;
3610    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3611    else                            s=sNoName;
3612    Werror("cannot dump to `%s`",s);
3613    return TRUE;
3614  }
3615  else
3616    return FALSE;
3617}
3618static BOOLEAN jjE(leftv res, leftv v)
3619{
3620  res->data = (char *)pOne();
3621  int co=(int)(long)v->Data();
3622  if (co>0)
3623  {
3624    pSetComp((poly)res->data,co);
3625    pSetm((poly)res->data);
3626  }
3627  else WerrorS("argument of gen must be positive");
3628  return (co<=0);
3629}
3630static BOOLEAN jjEXECUTE(leftv res, leftv v)
3631{
3632  char * d = (char *)v->Data();
3633  char * s = (char *)omAlloc(strlen(d) + 13);
3634  strcpy( s, (char *)d);
3635  strcat( s, "\n;RETURN();\n");
3636  newBuffer(s,BT_execute);
3637  return yyparse();
3638}
3639#ifdef HAVE_FACTORY
3640static BOOLEAN jjFACSTD(leftv res, leftv v)
3641{
3642  ideal_list p,h;
3643  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3644  lists L=(lists)omAllocBin(slists_bin);
3645  if (h==NULL)
3646  {
3647    L->Init(1);
3648    L->m[0].data=(char *)idInit(0,1);
3649    L->m[0].rtyp=IDEAL_CMD;
3650  }
3651  else
3652  {
3653    p=h;
3654    int l=0;
3655    while (p!=NULL) { p=p->next;l++; }
3656    L->Init(l);
3657    l=0;
3658    while(h!=NULL)
3659    {
3660      L->m[l].data=(char *)h->d;
3661      L->m[l].rtyp=IDEAL_CMD;
3662      p=h->next;
3663      omFreeSize(h,sizeof(*h));
3664      h=p;
3665      l++;
3666    }
3667  }
3668  res->data=(void *)L;
3669  return FALSE;
3670}
3671static BOOLEAN jjFAC_P(leftv res, leftv u)
3672{
3673  intvec *v=NULL;
3674  singclap_factorize_retry=0;
3675  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
3676  if (f==NULL) return TRUE;
3677  ivTest(v);
3678  lists l=(lists)omAllocBin(slists_bin);
3679  l->Init(2);
3680  l->m[0].rtyp=IDEAL_CMD;
3681  l->m[0].data=(void *)f;
3682  l->m[1].rtyp=INTVEC_CMD;
3683  l->m[1].data=(void *)v;
3684  res->data=(void *)l;
3685  return FALSE;
3686}
3687#endif
3688static BOOLEAN jjGETDUMP(leftv res, leftv v)
3689{
3690  si_link l = (si_link)v->Data();
3691  if (slGetDump(l))
3692  {
3693    const char *s;
3694    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3695    else                            s=sNoName;
3696    Werror("cannot get dump from `%s`",s);
3697    return TRUE;
3698  }
3699  else
3700    return FALSE;
3701}
3702static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
3703{
3704  assumeStdFlag(v);
3705  ideal I=(ideal)v->Data();
3706  res->data=(void *)iiHighCorner(I,0);
3707  return FALSE;
3708}
3709static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
3710{
3711  assumeStdFlag(v);
3712  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3713  BOOLEAN delete_w=FALSE;
3714  ideal I=(ideal)v->Data();
3715  int i;
3716  poly p=NULL,po=NULL;
3717  int rk=idRankFreeModule(I);
3718  if (w==NULL)
3719  {
3720    w = new intvec(rk);
3721    delete_w=TRUE;
3722  }
3723  for(i=rk;i>0;i--)
3724  {
3725    p=iiHighCorner(I,i);
3726    if (p==NULL)
3727    {
3728      WerrorS("module must be zero-dimensional");
3729      if (delete_w) delete w;
3730      return TRUE;
3731    }
3732    if (po==NULL)
3733    {
3734      po=p;
3735    }
3736    else
3737    {
3738      // now po!=NULL, p!=NULL
3739      int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
3740      if (d==0)
3741        d=pLmCmp(po,p);
3742      if (d > 0)
3743      {
3744        pDelete(&p);
3745      }
3746      else // (d < 0)
3747      {
3748        pDelete(&po); po=p;
3749      }
3750    }
3751  }
3752  if (delete_w) delete w;
3753  res->data=(void *)po;
3754  return FALSE;
3755}
3756static BOOLEAN jjHILBERT(leftv res, leftv v)
3757{
3758  assumeStdFlag(v);
3759  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3760  //scHilbertPoly((ideal)v->Data(),currQuotient);
3761  hLookSeries((ideal)v->Data(),module_w,currQuotient);
3762  return FALSE;
3763}
3764static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
3765{
3766  res->data=(void *)hSecondSeries((intvec *)v->Data());
3767  return FALSE;
3768}
3769static BOOLEAN jjHOMOG1(leftv res, leftv v)
3770{
3771  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3772  ideal v_id=(ideal)v->Data();
3773  if (w==NULL)
3774  {
3775    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
3776    if (res->data!=NULL)
3777    {
3778      if (v->rtyp==IDHDL)
3779      {
3780        char *s_isHomog=omStrDup("isHomog");
3781        if (v->e==NULL)
3782          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
3783        else
3784          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
3785      }
3786      else if (w!=NULL) delete w;
3787    } // if res->data==NULL then w==NULL
3788  }
3789  else
3790  {
3791    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
3792    if((res->data==NULL) && (v->rtyp==IDHDL))
3793    {
3794      if (v->e==NULL)
3795        atKill((idhdl)(v->data),"isHomog");
3796      else
3797        atKill((idhdl)(v->LData()),"isHomog");
3798    }
3799  }
3800  return FALSE;
3801}
3802static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
3803{
3804  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
3805  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
3806  if (IDELEMS((ideal)mat)==0)
3807  {
3808    idDelete((ideal *)&mat);
3809    mat=(matrix)idInit(1,1);
3810  }
3811  else
3812  {
3813    MATROWS(mat)=1;
3814    mat->rank=1;
3815    idTest((ideal)mat);
3816  }
3817  res->data=(char *)mat;
3818  return FALSE;
3819}
3820static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
3821{
3822  map m=(map)v->CopyD(MAP_CMD);
3823  omFree((ADDRESS)m->preimage);
3824  m->preimage=NULL;
3825  ideal I=(ideal)m;
3826  I->rank=1;
3827  res->data=(char *)I;
3828  return FALSE;
3829}
3830static BOOLEAN jjIDEAL_R(leftv res, leftv v)
3831{
3832  if (currRing!=NULL)
3833  {
3834    ring q=(ring)v->Data();
3835    if (rSamePolyRep(currRing, q))
3836    {
3837      if (q->qideal==NULL)
3838        res->data=(char *)idInit(1,1);
3839      else
3840        res->data=(char *)idCopy(q->qideal);
3841      return FALSE;
3842    }
3843  }
3844  WerrorS("can only get ideal from identical qring");
3845  return TRUE;
3846}
3847static BOOLEAN jjIm2Iv(leftv res, leftv v)
3848{
3849  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
3850  iv->makeVector();
3851  res->data = iv;
3852  return FALSE;
3853}
3854static BOOLEAN jjIMPART(leftv res, leftv v)
3855{
3856  res->data = (char *)nImPart((number)v->Data());
3857  return FALSE;
3858}
3859static BOOLEAN jjINDEPSET(leftv res, leftv v)
3860{
3861  assumeStdFlag(v);
3862  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
3863  return FALSE;
3864}
3865static BOOLEAN jjINTERRED(leftv res, leftv v)
3866{
3867  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
3868  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
3869  res->data = result;
3870  return FALSE;
3871}
3872static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
3873{
3874  res->data = (char *)(long)pVar((poly)v->Data());
3875  return FALSE;
3876}
3877static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
3878{
3879  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
3880  return FALSE;
3881}
3882static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
3883{
3884  res->data = (char *)0;
3885  return FALSE;
3886}
3887static BOOLEAN jjJACOB_P(leftv res, leftv v)
3888{
3889  ideal i=idInit(pVariables,1);
3890  int k;
3891  poly p=(poly)(v->Data());
3892  for (k=pVariables;k>0;k--)
3893  {
3894    i->m[k-1]=pDiff(p,k);
3895  }
3896  res->data = (char *)i;
3897  return FALSE;
3898}
3899/*2
3900 * compute Jacobi matrix of a module/matrix
3901 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables))  ),
3902 * where Mt := transpose(M)
3903 * Note that this is consistent with the current conventions for jacob in Singular,
3904 * whereas M2 computes its transposed.
3905 */
3906static BOOLEAN jjJACOB_M(leftv res, leftv a)
3907{
3908  ideal id = (ideal)a->Data();
3909  id = idTransp(id);
3910  int W = IDELEMS(id);
3911
3912  ideal result = idInit(W * pVariables, id->rank);
3913  poly *p = result->m;
3914
3915  for( int v = 1; v <= pVariables; v++ )
3916  {
3917    poly* q = id->m;
3918    for( int i = 0; i < W; i++, p++, q++ )
3919      *p = pDiff( *q, v );
3920  }
3921  idDelete(&id);
3922
3923  res->data = (char *)result;
3924  return FALSE;
3925}
3926
3927
3928static BOOLEAN jjKBASE(leftv res, leftv v)
3929{
3930  assumeStdFlag(v);
3931  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
3932  return FALSE;
3933}
3934#ifdef MDEBUG
3935static BOOLEAN jjpHead(leftv res, leftv v)
3936{
3937  res->data=(char *)pHead((poly)v->Data());
3938  return FALSE;
3939}
3940#endif
3941static BOOLEAN jjL2R(leftv res, leftv v)
3942{
3943  res->data=(char *)syConvList((lists)v->Data());
3944  if (res->data != NULL)
3945    return FALSE;
3946  else
3947    return TRUE;
3948}
3949static BOOLEAN jjLEADCOEF(leftv res, leftv v)
3950{
3951  poly p=(poly)v->Data();
3952  if (p==NULL)
3953  {
3954    res->data=(char *)nInit(0);
3955  }
3956  else
3957  {
3958    res->data=(char *)nCopy(pGetCoeff(p));
3959  }
3960  return FALSE;
3961}
3962static BOOLEAN jjLEADEXP(leftv res, leftv v)
3963{
3964  poly p=(poly)v->Data();
3965  int s=pVariables;
3966  if (v->Typ()==VECTOR_CMD) s++;
3967  intvec *iv=new intvec(s);
3968  if (p!=NULL)
3969  {
3970    for(int i = pVariables;i;i--)
3971    {
3972      (*iv)[i-1]=pGetExp(p,i);
3973    }
3974    if (s!=pVariables)
3975      (*iv)[pVariables]=pGetComp(p);
3976  }
3977  res->data=(char *)iv;
3978  return FALSE;
3979}
3980static BOOLEAN jjLEADMONOM(leftv res, leftv v)
3981{
3982  poly p=(poly)v->Data();
3983  if (p == NULL)
3984  {
3985    res->data = (char*) NULL;
3986  }
3987  else
3988  {
3989    poly lm = pLmInit(p);
3990    pSetCoeff(lm, nInit(1));
3991    res->data = (char*) lm;
3992  }
3993  return FALSE;
3994}
3995static BOOLEAN jjLOAD1(leftv res, leftv v)
3996{
3997  return jjLOAD(res, v,FALSE);
3998}
3999static BOOLEAN jjLISTRING(leftv res, leftv v)
4000{
4001  ring r=rCompose((lists)v->Data());
4002  if (r==NULL) return TRUE;
4003  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4004  res->data=(char *)r;
4005  return FALSE;
4006}
4007#if SIZEOF_LONG == 8
4008static number jjLONG2N(long d)
4009{
4010  int i=(int)d;
4011  if ((long)i == d)
4012  {
4013    return nlInit(i, NULL);
4014  }
4015  else
4016  {
4017#if !defined(OM_NDEBUG) && !defined(NDEBUG)
4018    omCheckBin(rnumber_bin);
4019#endif
4020    number z=(number)omAllocBin(rnumber_bin);
4021    #if defined(LDEBUG)
4022    z->debug=123456;
4023    #endif
4024    z->s=3;
4025    mpz_init_set_si(z->z,d);
4026    return z;
4027  }
4028}
4029#else
4030#define jjLONG2N(D) nlInit((int)D, NULL)
4031#endif
4032static BOOLEAN jjPFAC1(leftv res, leftv v)
4033{
4034  /* call method jjPFAC2 with second argument = 0 (meaning that no
4035     valid bound for the prime factors has been given) */
4036  sleftv tmp;
4037  memset(&tmp, 0, sizeof(tmp));
4038  tmp.rtyp = INT_CMD;
4039  return jjPFAC2(res, v, &tmp);
4040}
4041static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4042{
4043  /* computes the LU-decomposition of a matrix M;
4044     i.e., M = P * L * U, where
4045        - P is a row permutation matrix,
4046        - L is in lower triangular form,
4047        - U is in upper row echelon form
4048     Then, we also have P * M = L * U.
4049     A list [P, L, U] is returned. */
4050  matrix mat = (const matrix)v->Data();
4051  int rr = mat->rows();
4052  int cc = mat->cols();
4053  matrix pMat;
4054  matrix lMat;
4055  matrix uMat;
4056
4057  luDecomp(mat, pMat, lMat, uMat);
4058
4059  lists ll = (lists)omAllocBin(slists_bin);
4060  ll->Init(3);
4061  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4062  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4063  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4064  res->data=(char*)ll;
4065
4066  return FALSE;
4067}
4068static BOOLEAN jjMEMORY(leftv res, leftv v)
4069{
4070  omUpdateInfo();
4071  long d;
4072  switch(((int)(long)v->Data()))
4073  {
4074  case 0:
4075    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4076    break;
4077  case 1:
4078    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4079    break;
4080  case 2:
4081    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4082    break;
4083  default:
4084    omPrintStats(stdout);
4085    omPrintInfo(stdout);
4086    omPrintBinStats(stdout);
4087    res->data = (char *)0;
4088    res->rtyp = NONE;
4089  }
4090  return FALSE;
4091  res->data = (char *)0;
4092  return FALSE;
4093}
4094//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4095//{
4096//  return jjMONITOR2(res,v,NULL);
4097//}
4098static BOOLEAN jjMSTD(leftv res, leftv v)
4099{
4100  int t=v->Typ();
4101  ideal r,m;
4102  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4103  lists l=(lists)omAllocBin(slists_bin);
4104  l->Init(2);
4105  l->m[0].rtyp=t;
4106  l->m[0].data=(char *)r;
4107  setFlag(&(l->m[0]),FLAG_STD);
4108  l->m[1].rtyp=t;
4109  l->m[1].data=(char *)m;
4110  res->data=(char *)l;
4111  return FALSE;
4112}
4113static BOOLEAN jjMULT(leftv res, leftv v)
4114{
4115  assumeStdFlag(v);
4116  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4117  return FALSE;
4118}
4119static BOOLEAN jjMINRES_R(leftv res, leftv v)
4120{
4121  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4122  res->data=(char *)syMinimize((syStrategy)v->Data());
4123  if (weights!=NULL)
4124    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4125  return FALSE;
4126}
4127static BOOLEAN jjN2BI(leftv res, leftv v)
4128{
4129  number n,i; i=(number)v->Data();
4130  if (rField_is_Zp())
4131  {
4132    n=nlInit(npInt(i,currRing),NULL);
4133  }
4134  else if (rField_is_Q()) n=nlBigInt(i);
4135#ifdef HAVE_RINGS
4136  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
4137  else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
4138#endif
4139  else goto err;
4140  res->data=(void *)n;
4141  return FALSE;
4142err:
4143  WerrorS("cannot convert to bigint"); return TRUE;
4144}
4145static BOOLEAN jjNAMEOF(leftv res, leftv v)
4146{
4147  res->data = (char *)v->name;
4148  if (res->data==NULL) res->data=omStrDup("");
4149  v->name=NULL;
4150  return FALSE;
4151}
4152static BOOLEAN jjNAMES(leftv res, leftv v)
4153{
4154  res->data=ipNameList(((ring)v->Data())->idroot);
4155  return FALSE;
4156}
4157static BOOLEAN jjNVARS(leftv res, leftv v)
4158{
4159  res->data = (char *)(long)(((ring)(v->Data()))->N);
4160  return FALSE;
4161}
4162static BOOLEAN jjOpenClose(leftv res, leftv v)
4163{
4164  si_link l=(si_link)v->Data();
4165  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4166  else                return slClose(l);
4167}
4168static BOOLEAN jjORD(leftv res, leftv v)
4169{
4170  poly p=(poly)v->Data();
4171  res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
4172  return FALSE;
4173}
4174static BOOLEAN jjPAR1(leftv res, leftv v)
4175{
4176  int i=(int)(long)v->Data();
4177  int p=0;
4178  p=rPar(currRing);
4179  if ((0<i) && (i<=p))
4180  {
4181    res->data=(char *)nPar(i);
4182  }
4183  else
4184  {
4185    Werror("par number %d out of range 1..%d",i,p);
4186    return TRUE;
4187  }
4188  return FALSE;
4189}
4190static BOOLEAN jjPARDEG(leftv res, leftv v)
4191{
4192  res->data = (char *)(long)nParDeg((number)v->Data());
4193  return FALSE;
4194}
4195static BOOLEAN jjPARSTR1(leftv res, leftv v)
4196{
4197  if (currRing==NULL)
4198  {
4199    WerrorS("no ring active");
4200    return TRUE;
4201  }
4202  int i=(int)(long)v->Data();
4203  int p=0;
4204  if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
4205    res->data=omStrDup(currRing->parameter[i-1]);
4206  else
4207  {
4208    Werror("par number %d out of range 1..%d",i,p);
4209    return TRUE;
4210  }
4211  return FALSE;
4212}
4213static BOOLEAN jjP2BI(leftv res, leftv v)
4214{
4215  poly p=(poly)v->Data();
4216  if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
4217  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4218  {
4219    WerrorS("poly must be constant");
4220    return TRUE;
4221  }
4222  number i=pGetCoeff(p);
4223  number n;
4224  if (rField_is_Zp())
4225  {
4226    n=nlInit(npInt(i,currRing), NULL);
4227  }
4228  else if (rField_is_Q()) n=nlBigInt(i);
4229#ifdef HAVE_RINGS
4230  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
4231    n=nlMapGMP(i);
4232  else if (rField_is_Ring_2toM())
4233    n=nlInit((unsigned long) i, NULL);
4234#endif
4235  else goto err;
4236  res->data=(void *)n;
4237  return FALSE;
4238err:
4239  WerrorS("cannot convert to bigint"); return TRUE;
4240}
4241static BOOLEAN jjP2I(leftv res, leftv v)
4242{
4243  poly p=(poly)v->Data();
4244  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4245  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4246  {
4247    WerrorS("poly must be constant");
4248    return TRUE;
4249  }
4250  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
4251  return FALSE;
4252}
4253static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4254{
4255  map mapping=(map)v->Data();
4256  syMake(res,omStrDup(mapping->preimage));
4257  return FALSE;
4258}
4259static BOOLEAN jjPRIME(leftv res, leftv v)
4260{
4261  int i = IsPrime((int)(long)(v->Data()));
4262  res->data = (char *)(long)(i > 1 ? i : 2);
4263  return FALSE;
4264}
4265static BOOLEAN jjPRUNE(leftv res, leftv v)
4266{
4267  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4268  ideal v_id=(ideal)v->Data();
4269  if (w!=NULL)
4270  {
4271    if (!idTestHomModule(v_id,currQuotient,w))
4272    {
4273      WarnS("wrong weights");
4274      w=NULL;
4275      // and continue at the non-homog case below
4276    }
4277    else
4278    {
4279      w=ivCopy(w);
4280      intvec **ww=&w;
4281      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4282      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4283      return FALSE;
4284    }
4285  }
4286  res->data = (char *)idMinEmbedding(v_id);
4287  return FALSE;
4288}
4289static BOOLEAN jjP2N(leftv res, leftv v)
4290{
4291  number n;
4292  poly p;
4293  if (((p=(poly)v->Data())!=NULL)
4294  && (pIsConstant(p)))
4295  {
4296    n=nCopy(pGetCoeff(p));
4297  }
4298  else
4299  {
4300    n=nInit(0);
4301  }
4302  res->data = (char *)n;
4303  return FALSE;
4304}
4305static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4306{
4307  char *s= (char *)v->Data();
4308  int i = 1;
4309  int l = strlen(s);
4310  for(i=0; i<sArithBase.nCmdUsed; i++)
4311  {
4312    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4313    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4314    {
4315      res->data = (char *)1;
4316      return FALSE;
4317    }
4318  }
4319  //res->data = (char *)0;
4320  return FALSE;
4321}
4322static BOOLEAN jjRANK1(leftv res, leftv v)
4323{
4324  matrix m =(matrix)v->Data();
4325  int rank = luRank(m, 0);
4326  res->data =(char *)(long)rank;
4327  return FALSE;
4328}
4329static BOOLEAN jjREAD(leftv res, leftv v)
4330{
4331  return jjREAD2(res,v,NULL);
4332}
4333static BOOLEAN jjREGULARITY(leftv res, leftv v)
4334{
4335  res->data = (char *)(long)iiRegularity((lists)v->Data());
4336  return FALSE;
4337}
4338static BOOLEAN jjREPART(leftv res, leftv v)
4339{
4340  res->data = (char *)nRePart((number)v->Data());
4341  return FALSE;
4342}
4343static BOOLEAN jjRINGLIST(leftv res, leftv v)
4344{
4345  ring r=(ring)v->Data();
4346  if (r!=NULL)
4347    res->data = (char *)rDecompose((ring)v->Data());
4348  return (r==NULL)||(res->data==NULL);
4349}
4350static BOOLEAN jjROWS(leftv res, leftv v)
4351{
4352  ideal i = (ideal)v->Data();
4353  res->data = (char *)i->rank;
4354  return FALSE;
4355}
4356static BOOLEAN jjROWS_IV(leftv res, leftv v)
4357{
4358  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4359  return FALSE;
4360}
4361static BOOLEAN jjRPAR(leftv res, leftv v)
4362{
4363  res->data = (char *)(long)rPar(((ring)v->Data()));
4364  return FALSE;
4365}
4366static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4367{
4368#ifdef HAVE_PLURAL
4369  const bool bIsSCA = rIsSCA(currRing);
4370#else
4371  const bool bIsSCA = false;
4372#endif
4373
4374  if ((currQuotient!=NULL) && !bIsSCA)
4375  {
4376    WerrorS("qring not supported by slimgb at the moment");
4377    return TRUE;
4378  }
4379  if (rHasLocalOrMixedOrdering_currRing())
4380  {
4381    WerrorS("ordering must be global for slimgb");
4382    return TRUE;
4383  }
4384  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4385  tHomog hom=testHomog;
4386  ideal u_id=(ideal)u->Data();
4387  if (w!=NULL)
4388  {
4389    if (!idTestHomModule(u_id,currQuotient,w))
4390    {
4391      WarnS("wrong weights");
4392      w=NULL;
4393    }
4394    else
4395    {
4396      w=ivCopy(w);
4397      hom=isHomog;
4398    }
4399  }
4400
4401  assume(u_id->rank>=idRankFreeModule(u_id));
4402  res->data=(char *)t_rep_gb(currRing,
4403    u_id,u_id->rank);
4404  //res->data=(char *)t_rep_gb(currRing, u_id);
4405
4406  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4407  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4408  return FALSE;
4409}
4410static BOOLEAN jjSTD(leftv res, leftv v)
4411{
4412  ideal result;
4413  ideal v_id=(ideal)v->Data();
4414  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4415  tHomog hom=testHomog;
4416  if (w!=NULL)
4417  {
4418    if (!idTestHomModule(v_id,currQuotient,w))
4419    {
4420      WarnS("wrong weights");
4421      w=NULL;
4422    }
4423    else
4424    {
4425      hom=isHomog;
4426      w=ivCopy(w);
4427    }
4428  }
4429  result=kStd(v_id,currQuotient,hom,&w);
4430  idSkipZeroes(result);
4431  res->data = (char *)result;
4432  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4433  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4434  return FALSE;
4435}
4436static BOOLEAN jjSort_Id(leftv res, leftv v)
4437{
4438  res->data = (char *)idSort((ideal)v->Data());
4439  return FALSE;
4440}
4441#ifdef HAVE_FACTORY
4442extern int singclap_factorize_retry;
4443static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4444{
4445  intvec *v=NULL;
4446  singclap_factorize_retry=0;
4447  ideal f=singclap_sqrfree((poly)(u->CopyD()));
4448  if (f==NULL)
4449    return TRUE;
4450  res->data=(void *)f;
4451  return FALSE;
4452}
4453#endif
4454#if 1
4455static BOOLEAN jjSYZYGY(leftv res, leftv v)
4456{
4457  intvec *w=NULL;
4458  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4459  if (w!=NULL) delete w;
4460  return FALSE;
4461}
4462#else
4463// activate, if idSyz handle module weights correctly !
4464static BOOLEAN jjSYZYGY(leftv res, leftv v)
4465{
4466  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4467  ideal v_id=(ideal)v->Data();
4468  tHomog hom=testHomog;
4469  int add_row_shift=0;
4470  if (w!=NULL)
4471  {
4472    w=ivCopy(w);
4473    add_row_shift=w->min_in();
4474    (*w)-=add_row_shift;
4475    if (idTestHomModule(v_id,currQuotient,w))
4476      hom=isHomog;
4477    else
4478    {
4479      //WarnS("wrong weights");
4480      delete w; w=NULL;
4481      hom=testHomog;
4482    }
4483  }
4484  res->data = (char *)idSyzygies(v_id,hom,&w);
4485  if (w!=NULL)
4486  {
4487    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4488  }
4489  return FALSE;
4490}
4491#endif
4492static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4493{
4494  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4495  return FALSE;
4496}
4497static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4498{
4499  res->data = (char *)ivTranp((intvec*)(v->Data()));
4500  return FALSE;
4501}
4502#ifdef HAVE_PLURAL
4503static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4504{
4505  ring    r = (ring)a->Data();
4506  //if (rIsPluralRing(r))
4507  if (r->OrdSgn==1)
4508  {
4509    res->data = rOpposite(r);
4510  }
4511  else
4512  {
4513    WarnS("opposite only for global orderings");
4514    res->data = rCopy(r);
4515  }
4516  return FALSE;
4517}
4518static BOOLEAN jjENVELOPE(leftv res, leftv a)
4519{
4520  ring    r = (ring)a->Data();
4521  if (rIsPluralRing(r))
4522  {
4523    //    ideal   i;
4524//     if (a->rtyp == QRING_CMD)
4525//     {
4526//       i = r->qideal;
4527//       r->qideal = NULL;
4528//     }
4529    ring s = rEnvelope(r);
4530//     if (a->rtyp == QRING_CMD)
4531//     {
4532//       ideal is  = idOppose(r,i); /* twostd? */
4533//       is        = idAdd(is,i);
4534//       s->qideal = i;
4535//     }
4536    res->data = s;
4537  }
4538  else  res->data = rCopy(r);
4539  return FALSE;
4540}
4541static BOOLEAN jjTWOSTD(leftv res, leftv a)
4542{
4543  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4544  else  res->data=(ideal)a->CopyD();
4545  setFlag(res,FLAG_STD);
4546  setFlag(res,FLAG_TWOSTD);
4547  return FALSE;
4548}
4549#endif
4550
4551static BOOLEAN jjTYPEOF(leftv res, leftv v)
4552{
4553  int t=(int)(long)v->data;
4554  switch (t)
4555  {
4556    case INT_CMD:        res->data=omStrDup("int"); break;
4557    case POLY_CMD:       res->data=omStrDup("poly"); break;
4558    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
4559    case STRING_CMD:     res->data=omStrDup("string"); break;
4560    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
4561    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
4562    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
4563    case MODUL_CMD:      res->data=omStrDup("module"); break;
4564    case MAP_CMD:        res->data=omStrDup("map"); break;
4565    case PROC_CMD:       res->data=omStrDup("proc"); break;
4566    case RING_CMD:       res->data=omStrDup("ring"); break;
4567    case QRING_CMD:      res->data=omStrDup("qring"); break;
4568    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
4569    case NUMBER_CMD:     res->data=omStrDup("number"); break;
4570    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
4571    case LIST_CMD:       res->data=omStrDup("list"); break;
4572    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
4573    case LINK_CMD:       res->data=omStrDup("link"); break;
4574    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
4575    case DEF_CMD:
4576    case NONE:           res->data=omStrDup("none"); break;
4577    default:
4578    {
4579      if (t>MAX_TOK)
4580        res->data=omStrDup(getBlackboxName(t));
4581      else
4582        res->data=omStrDup("?unknown type?");
4583      break;
4584    }
4585  }
4586  return FALSE;
4587}
4588static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
4589{
4590  res->data=(char *)pIsUnivariate((poly)v->Data());
4591  return FALSE;
4592}
4593static BOOLEAN jjVAR1(leftv res, leftv v)
4594{
4595  int i=(int)(long)v->Data();
4596  if ((0<i) && (i<=currRing->N))
4597  {
4598    poly p=pOne();
4599    pSetExp(p,i,1);
4600    pSetm(p);
4601    res->data=(char *)p;
4602  }
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 jjVARSTR1(leftv res, leftv v)
4611{
4612  if (currRing==NULL)
4613  {
4614    WerrorS("no ring active");
4615    return TRUE;
4616  }
4617  int i=(int)(long)v->Data();
4618  if ((0<i) && (i<=currRing->N))
4619    res->data=omStrDup(currRing->names[i-1]);
4620  else
4621  {
4622    Werror("var number %d out of range 1..%d",i,currRing->N);
4623    return TRUE;
4624  }
4625  return FALSE;
4626}
4627static BOOLEAN jjVDIM(leftv res, leftv v)
4628{
4629  assumeStdFlag(v);
4630  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
4631  return FALSE;
4632}
4633BOOLEAN jjWAIT1ST1(leftv res, leftv u)
4634{
4635// input: u: a list with links of type
4636//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4637// returns: -1:  the read state of all links is eof
4638//          i>0: (at least) u[i] is ready
4639  lists Lforks = (lists)u->Data();
4640  int i = slStatusSsiL(Lforks, -1);
4641  if(i == -2) /* error */
4642  {
4643    return TRUE;
4644  }
4645  res->data = (void*)(long)i;
4646  return FALSE;
4647}
4648BOOLEAN jjWAITALL1(leftv res, leftv u)
4649{
4650// input: u: a list with links of type
4651//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4652// returns: -1: the read state of all links is eof
4653//           1: all links are ready
4654//              (caution: at least one is ready, but some maybe dead)
4655  lists Lforks = (lists)u->CopyD();
4656  int i;
4657  int j = -1;
4658  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
4659  {
4660    i = slStatusSsiL(Lforks, -1);
4661    if(i == -2) /* error */
4662    {
4663      return TRUE;
4664    }
4665    if(i == -1)
4666    {
4667      break;
4668    }
4669    j = 1;
4670    Lforks->m[i-1].CleanUp();
4671    Lforks->m[i-1].rtyp=DEF_CMD;
4672    Lforks->m[i-1].data=NULL;
4673  }
4674  res->data = (void*)(long)j;
4675  Lforks->Clean();
4676  return FALSE;
4677}
4678static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
4679{
4680  char * s=(char *)v->CopyD();
4681  char libnamebuf[256];
4682  lib_types LT = type_of_LIB(s, libnamebuf);
4683#ifdef HAVE_DYNAMIC_LOADING
4684  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
4685#endif /* HAVE_DYNAMIC_LOADING */
4686  switch(LT)
4687  {
4688      default:
4689      case LT_NONE:
4690        Werror("%s: unknown type", s);
4691        break;
4692      case LT_NOTFOUND:
4693        Werror("cannot open %s", s);
4694        break;
4695
4696      case LT_SINGULAR:
4697      {
4698        char *plib = iiConvName(s);
4699        idhdl pl = IDROOT->get(plib,0);
4700        if (pl==NULL)
4701        {
4702          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
4703          IDPACKAGE(pl)->language = LANG_SINGULAR;
4704          IDPACKAGE(pl)->libname=omStrDup(plib);
4705        }
4706        else if (IDTYP(pl)!=PACKAGE_CMD)
4707        {
4708          Werror("can not create package `%s`",plib);
4709          omFree(plib);
4710          return TRUE;
4711        }
4712        package savepack=currPack;
4713        currPack=IDPACKAGE(pl);
4714        IDPACKAGE(pl)->loaded=TRUE;
4715        char libnamebuf[256];
4716        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
4717        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
4718        currPack=savepack;
4719        IDPACKAGE(pl)->loaded=(!bo);
4720        return bo;
4721      }
4722      case LT_MACH_O:
4723      case LT_ELF:
4724      case LT_HPUX:
4725#ifdef HAVE_DYNAMIC_LOADING
4726        return load_modules(s, libnamebuf, autoexport);
4727#else /* HAVE_DYNAMIC_LOADING */
4728        WerrorS("Dynamic modules are not supported by this version of Singular");
4729        break;
4730#endif /* HAVE_DYNAMIC_LOADING */
4731  }
4732  return TRUE;
4733}
4734
4735#ifdef INIT_BUG
4736#define XS(A) -((short)A)
4737#define jjstrlen       (proc1)1
4738#define jjpLength      (proc1)2
4739#define jjidElem       (proc1)3
4740#define jjmpDetBareiss (proc1)4
4741#define jjidFreeModule (proc1)5
4742#define jjidVec2Ideal  (proc1)6
4743#define jjrCharStr     (proc1)7
4744#ifndef MDEBUG
4745#define jjpHead        (proc1)8
4746#endif
4747#define jjidHead       (proc1)9
4748#define jjidMaxIdeal   (proc1)10
4749#define jjidMinBase    (proc1)11
4750#define jjsyMinBase    (proc1)12
4751#define jjpMaxComp     (proc1)13
4752#define jjmpTrace      (proc1)14
4753#define jjmpTransp     (proc1)15
4754#define jjrOrdStr      (proc1)16
4755#define jjrVarStr      (proc1)18
4756#define jjrParStr      (proc1)19
4757#define jjCOUNT_RES    (proc1)22
4758#define jjDIM_R        (proc1)23
4759#define jjidTransp     (proc1)24
4760
4761extern struct sValCmd1 dArith1[];
4762void jjInitTab1()
4763{
4764  int i=0;
4765  for (;dArith1[i].cmd!=0;i++)
4766  {
4767    if (dArith1[i].res<0)
4768    {
4769      switch ((int)dArith1[i].p)
4770      {
4771        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
4772        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
4773        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
4774        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
4775#ifndef HAVE_FACTORY
4776        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
4777#endif
4778        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
4779        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
4780#ifndef MDEBUG
4781        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
4782#endif
4783        case (int)jjidHead:       dArith1[i].p=(proc1)idHead; break;
4784        case (int)jjidMaxIdeal:   dArith1[i].p=(proc1)idMaxIdeal; break;
4785        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
4786        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
4787        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
4788        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
4789        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
4790        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
4791        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
4792        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
4793        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
4794        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
4795        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
4796        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
4797      }
4798    }
4799  }
4800}
4801#else
4802#if defined(PROC_BUG)
4803#define XS(A) A
4804static BOOLEAN jjstrlen(leftv res, leftv v)
4805{
4806  res->data = (char *)strlen((char *)v->Data());
4807  return FALSE;
4808}
4809static BOOLEAN jjpLength(leftv res, leftv v)
4810{
4811  res->data = (char *)pLength((poly)v->Data());
4812  return FALSE;
4813}
4814static BOOLEAN jjidElem(leftv res, leftv v)
4815{
4816  res->data = (char *)idElem((ideal)v->Data());
4817  return FALSE;
4818}
4819static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
4820{
4821  res->data = (char *)mpDetBareiss((matrix)v->Data());
4822  return FALSE;
4823}
4824static BOOLEAN jjidFreeModule(leftv res, leftv v)
4825{
4826  res->data = (char *)idFreeModule((int)(long)v->Data());
4827  return FALSE;
4828}
4829static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
4830{
4831  res->data = (char *)idVec2Ideal((poly)v->Data());
4832  return FALSE;
4833}
4834static BOOLEAN jjrCharStr(leftv res, leftv v)
4835{
4836  res->data = rCharStr((ring)v->Data());
4837  return FALSE;
4838}
4839#ifndef MDEBUG
4840static BOOLEAN jjpHead(leftv res, leftv v)
4841{
4842  res->data = (char *)pHead((poly)v->Data());
4843  return FALSE;
4844}
4845#endif
4846static BOOLEAN jjidHead(leftv res, leftv v)
4847{
4848  res->data = (char *)idHead((ideal)v->Data());
4849  return FALSE;
4850}
4851static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4852{
4853  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4854  return FALSE;
4855}
4856static BOOLEAN jjidMinBase(leftv res, leftv v)
4857{
4858  res->data = (char *)idMinBase((ideal)v->Data());
4859  return FALSE;
4860}
4861static BOOLEAN jjsyMinBase(leftv res, leftv v)
4862{
4863  res->data = (char *)syMinBase((ideal)v->Data());
4864  return FALSE;
4865}
4866static BOOLEAN jjpMaxComp(leftv res, leftv v)
4867{
4868  res->data = (char *)pMaxComp((poly)v->Data());
4869  return FALSE;
4870}
4871static BOOLEAN jjmpTrace(leftv res, leftv v)
4872{
4873  res->data = (char *)mpTrace((matrix)v->Data());
4874  return FALSE;
4875}
4876static BOOLEAN jjmpTransp(leftv res, leftv v)
4877{
4878  res->data = (char *)mpTransp((matrix)v->Data());
4879  return FALSE;
4880}
4881static BOOLEAN jjrOrdStr(leftv res, leftv v)
4882{
4883  res->data = rOrdStr((ring)v->Data());
4884  return FALSE;
4885}
4886static BOOLEAN jjrVarStr(leftv res, leftv v)
4887{
4888  res->data = rVarStr((ring)v->Data());
4889  return FALSE;
4890}
4891static BOOLEAN jjrParStr(leftv res, leftv v)
4892{
4893  res->data = rParStr((ring)v->Data());
4894  return FALSE;
4895}
4896static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
4897{
4898  res->data=(char *)sySize((syStrategy)v->Data());
4899  return FALSE;
4900}
4901static BOOLEAN jjDIM_R(leftv res, leftv v)
4902{
4903  res->data = (char *)syDim((syStrategy)v->Data());
4904  return FALSE;
4905}
4906static BOOLEAN jjidTransp(leftv res, leftv v)
4907{
4908  res->data = (char *)idTransp((ideal)v->Data());
4909  return FALSE;
4910}
4911#else
4912#define XS(A)          -((short)A)
4913#define jjstrlen       (proc1)strlen
4914#define jjpLength      (proc1)pLength
4915#define jjidElem       (proc1)idElem
4916#define jjmpDetBareiss (proc1)mpDetBareiss
4917#define jjidFreeModule (proc1)idFreeModule
4918#define jjidVec2Ideal  (proc1)idVec2Ideal
4919#define jjrCharStr     (proc1)rCharStr
4920#ifndef MDEBUG
4921#define jjpHead        (proc1)pHeadProc
4922#endif
4923#define jjidHead       (proc1)idHead
4924#define jjidMaxIdeal   (proc1)idMaxIdeal
4925#define jjidMinBase    (proc1)idMinBase
4926#define jjsyMinBase    (proc1)syMinBase
4927#define jjpMaxComp     (proc1)pMaxCompProc
4928#define jjmpTrace      (proc1)mpTrace
4929#define jjmpTransp     (proc1)mpTransp
4930#define jjrOrdStr      (proc1)rOrdStr
4931#define jjrVarStr      (proc1)rVarStr
4932#define jjrParStr      (proc1)rParStr
4933#define jjCOUNT_RES    (proc1)sySize
4934#define jjDIM_R        (proc1)syDim
4935#define jjidTransp     (proc1)idTransp
4936#endif
4937#endif
4938static BOOLEAN jjnInt(leftv res, leftv u)
4939{
4940  number n=(number)u->Data();
4941  res->data=(char *)(long)n_Int(n,currRing);
4942  return FALSE;
4943}
4944static BOOLEAN jjnlInt(leftv res, leftv u)
4945{
4946  number n=(number)u->Data();
4947  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
4948  return FALSE;
4949}
4950/*=================== operations with 3 args.: static proc =================*/
4951/* must be ordered: first operations for chars (infix ops),
4952 * then alphabetically */
4953static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
4954{
4955  char *s= (char *)u->Data();
4956  int   r = (int)(long)v->Data();
4957  int   c = (int)(long)w->Data();
4958  int l = strlen(s);
4959
4960  if ( (r<1) || (r>l) || (c<0) )
4961  {
4962    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
4963    return TRUE;
4964  }
4965  res->data = (char *)omAlloc((long)(c+1));
4966  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
4967  return FALSE;
4968}
4969static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
4970{
4971  intvec *iv = (intvec *)u->Data();
4972  int   r = (int)(long)v->Data();
4973  int   c = (int)(long)w->Data();
4974  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
4975  {
4976    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
4977           r,c,u->Fullname(),iv->rows(),iv->cols());
4978    return TRUE;
4979  }
4980  res->data=u->data; u->data=NULL;
4981  res->rtyp=u->rtyp; u->rtyp=0;
4982  res->name=u->name; u->name=NULL;
4983  Subexpr e=jjMakeSub(v);
4984          e->next=jjMakeSub(w);
4985  if (u->e==NULL) res->e=e;
4986  else
4987  {
4988    Subexpr h=u->e;
4989    while (h->next!=NULL) h=h->next;
4990    h->next=e;
4991    res->e=u->e;
4992    u->e=NULL;
4993  }
4994  return FALSE;
4995}
4996static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
4997{
4998  matrix m= (matrix)u->Data();
4999  int   r = (int)(long)v->Data();
5000  int   c = (int)(long)w->Data();
5001  //Print("gen. elem %d, %d\n",r,c);
5002  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5003  {
5004    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5005      MATROWS(m),MATCOLS(m));
5006    return TRUE;
5007  }
5008  res->data=u->data; u->data=NULL;
5009  res->rtyp=u->rtyp; u->rtyp=0;
5010  res->name=u->name; u->name=NULL;
5011  Subexpr e=jjMakeSub(v);
5012          e->next=jjMakeSub(w);
5013  if (u->e==NULL)
5014    res->e=e;
5015  else
5016  {
5017    Subexpr h=u->e;
5018    while (h->next!=NULL) h=h->next;
5019    h->next=e;
5020    res->e=u->e;
5021    u->e=NULL;
5022  }
5023  return FALSE;
5024}
5025static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5026{
5027  sleftv t;
5028  sleftv ut;
5029  leftv p=NULL;
5030  intvec *iv=(intvec *)w->Data();
5031  int l;
5032  BOOLEAN nok;
5033
5034  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5035  {
5036    WerrorS("cannot build expression lists from unnamed objects");
5037    return TRUE;
5038  }
5039  memcpy(&ut,u,sizeof(ut));
5040  memset(&t,0,sizeof(t));
5041  t.rtyp=INT_CMD;
5042  for (l=0;l< iv->length(); l++)
5043  {
5044    t.data=(char *)(long)((*iv)[l]);
5045    if (p==NULL)
5046    {
5047      p=res;
5048    }
5049    else
5050    {
5051      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5052      p=p->next;
5053    }
5054    memcpy(u,&ut,sizeof(ut));
5055    if (u->Typ() == MATRIX_CMD)
5056      nok=jjBRACK_Ma(p,u,v,&t);
5057    else /* INTMAT_CMD */
5058      nok=jjBRACK_Im(p,u,v,&t);
5059    if (nok)
5060    {
5061      while (res->next!=NULL)
5062      {
5063        p=res->next->next;
5064        omFreeBin((ADDRESS)res->next, sleftv_bin);
5065        // res->e aufraeumen !!!!
5066        res->next=p;
5067      }
5068      return TRUE;
5069    }
5070  }
5071  return FALSE;
5072}
5073static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5074{
5075  sleftv t;
5076  sleftv ut;
5077  leftv p=NULL;
5078  intvec *iv=(intvec *)v->Data();
5079  int l;
5080  BOOLEAN nok;
5081
5082  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5083  {
5084    WerrorS("cannot build expression lists from unnamed objects");
5085    return TRUE;
5086  }
5087  memcpy(&ut,u,sizeof(ut));
5088  memset(&t,0,sizeof(t));
5089  t.rtyp=INT_CMD;
5090  for (l=0;l< iv->length(); l++)
5091  {
5092    t.data=(char *)(long)((*iv)[l]);
5093    if (p==NULL)
5094    {
5095      p=res;
5096    }
5097    else
5098    {
5099      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5100      p=p->next;
5101    }
5102    memcpy(u,&ut,sizeof(ut));
5103    if (u->Typ() == MATRIX_CMD)
5104      nok=jjBRACK_Ma(p,u,&t,w);
5105    else /* INTMAT_CMD */
5106      nok=jjBRACK_Im(p,u,&t,w);
5107    if (nok)
5108    {
5109      while (res->next!=NULL)
5110      {
5111        p=res->next->next;
5112        omFreeBin((ADDRESS)res->next, sleftv_bin);
5113        // res->e aufraeumen !!
5114        res->next=p;
5115      }
5116      return TRUE;
5117    }
5118  }
5119  return FALSE;
5120}
5121static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5122{
5123  sleftv t1,t2,ut;
5124  leftv p=NULL;
5125  intvec *vv=(intvec *)v->Data();
5126  intvec *wv=(intvec *)w->Data();
5127  int vl;
5128  int wl;
5129  BOOLEAN nok;
5130
5131  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5132  {
5133    WerrorS("cannot build expression lists from unnamed objects");
5134    return TRUE;
5135  }
5136  memcpy(&ut,u,sizeof(ut));
5137  memset(&t1,0,sizeof(sleftv));
5138  memset(&t2,0,sizeof(sleftv));
5139  t1.rtyp=INT_CMD;
5140  t2.rtyp=INT_CMD;
5141  for (vl=0;vl< vv->length(); vl++)
5142  {
5143    t1.data=(char *)(long)((*vv)[vl]);
5144    for (wl=0;wl< wv->length(); wl++)
5145    {
5146      t2.data=(char *)(long)((*wv)[wl]);
5147      if (p==NULL)
5148      {
5149        p=res;
5150      }
5151      else
5152      {
5153        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5154        p=p->next;
5155      }
5156      memcpy(u,&ut,sizeof(ut));
5157      if (u->Typ() == MATRIX_CMD)
5158        nok=jjBRACK_Ma(p,u,&t1,&t2);
5159      else /* INTMAT_CMD */
5160        nok=jjBRACK_Im(p,u,&t1,&t2);
5161      if (nok)
5162      {
5163        res->CleanUp();
5164        return TRUE;
5165      }
5166    }
5167  }
5168  return FALSE;
5169}
5170static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5171{
5172  v->next=(leftv)omAllocBin(sleftv_bin);
5173  memcpy(v->next,w,sizeof(sleftv));
5174  memset(w,0,sizeof(sleftv));
5175  return jjPROC(res,u,v);
5176}
5177static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5178{
5179  u->next=(leftv)omAllocBin(sleftv_bin);
5180  memcpy(u->next,v,sizeof(sleftv));
5181  u->next->next=(leftv)omAllocBin(sleftv_bin);
5182  memcpy(u->next->next,w,sizeof(sleftv));
5183  BOOLEAN r=iiExprArithM(res,u,iiOp);
5184  v->Init();
5185  w->Init();
5186  //w->rtyp=0; w->data=NULL;
5187  // iiExprArithM did the CleanUp
5188  return r;
5189}
5190static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5191{
5192  intvec *iv;
5193  ideal m;
5194  lists l=(lists)omAllocBin(slists_bin);
5195  int k=(int)(long)w->Data();
5196  if (k>=0)
5197  {
5198    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5199    l->Init(2);
5200    l->m[0].rtyp=MODUL_CMD;
5201    l->m[1].rtyp=INTVEC_CMD;
5202    l->m[0].data=(void *)m;
5203    l->m[1].data=(void *)iv;
5204  }
5205  else
5206  {
5207    m=smCallSolv((ideal)u->Data());
5208    l->Init(1);
5209    l->m[0].rtyp=IDEAL_CMD;
5210    l->m[0].data=(void *)m;
5211  }
5212  res->data = (char *)l;
5213  return FALSE;
5214}
5215static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5216{
5217  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5218  {
5219    WerrorS("3rd argument must be a name of a matrix");
5220    return TRUE;
5221  }
5222  ideal i=(ideal)u->Data();
5223  int rank=(int)i->rank;
5224  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5225  if (r) return TRUE;
5226  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5227  return FALSE;
5228}
5229static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5230{
5231  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5232           (ideal)(v->Data()),(poly)(w->Data()));
5233  return FALSE;
5234}
5235static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5236{
5237  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5238  {
5239    WerrorS("3rd argument must be a name of a matrix");
5240    return TRUE;
5241  }
5242  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5243  poly p=(poly)u->CopyD(POLY_CMD);
5244  ideal i=idInit(1,1);
5245  i->m[0]=p;
5246  sleftv t;
5247  memset(&t,0,sizeof(t));
5248  t.data=(char *)i;
5249  t.rtyp=IDEAL_CMD;
5250  int rank=1;
5251  if (u->Typ()==VECTOR_CMD)
5252  {
5253    i->rank=rank=pMaxComp(p);
5254    t.rtyp=MODUL_CMD;
5255  }
5256  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5257  t.CleanUp();
5258  if (r) return TRUE;
5259  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5260  return FALSE;
5261}
5262static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5263{
5264  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5265    (intvec *)w->Data());
5266  //setFlag(res,FLAG_STD);
5267  return FALSE;
5268}
5269static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5270{
5271  /*4
5272  * look for the substring what in the string where
5273  * starting at position n
5274  * return the position of the first char of what in where
5275  * or 0
5276  */
5277  int n=(int)(long)w->Data();
5278  char *where=(char *)u->Data();
5279  char *what=(char *)v->Data();
5280  char *found;
5281  if ((1>n)||(n>(int)strlen(where)))
5282  {
5283    Werror("start position %d out of range",n);
5284    return TRUE;
5285  }
5286  found = strchr(where+n-1,*what);
5287  if (*(what+1)!='\0')
5288  {
5289    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5290    {
5291      found=strchr(found+1,*what);
5292    }
5293  }
5294  if (found != NULL)
5295  {
5296    res->data=(char *)((found-where)+1);
5297  }
5298  return FALSE;
5299}
5300static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5301{
5302  if ((int)(long)w->Data()==0)
5303    res->data=(char *)walkProc(u,v);
5304  else
5305    res->data=(char *)fractalWalkProc(u,v);
5306  setFlag( res, FLAG_STD );
5307  return FALSE;
5308}
5309static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5310{
5311  assumeStdFlag(u);
5312  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5313  intvec *wdegree=(intvec*)w->Data();
5314  if (wdegree->length()!=pVariables)
5315  {
5316    Werror("weight vector must have size %d, not %d",
5317           pVariables,wdegree->length());
5318    return TRUE;
5319  }
5320  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5321  switch((int)(long)v->Data())
5322  {
5323    case 1:
5324      res->data=(void *)iv;
5325      return FALSE;
5326    case 2:
5327      res->data=(void *)hSecondSeries(iv);
5328      delete iv;
5329      return FALSE;
5330  }
5331  WerrorS(feNotImplemented);
5332  delete iv;
5333  return TRUE;
5334}
5335static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5336{
5337  PrintS("TODO\n");
5338  int i=pVar((poly)v->Data());
5339  if (i==0)
5340  {
5341    WerrorS("ringvar expected");
5342    return TRUE;
5343  }
5344  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5345  int d=pWTotaldegree(p);
5346  pLmDelete(p);
5347  if (d==1)
5348    res->data = (char *)idHomogen((ideal)u->Data(),i);
5349  else
5350    WerrorS("variable must have weight 1");
5351  return (d!=1);
5352}
5353static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5354{
5355  PrintS("TODO\n");
5356  int i=pVar((poly)v->Data());
5357  if (i==0)
5358  {
5359    WerrorS("ringvar expected");
5360    return TRUE;
5361  }
5362  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5363  int d=pWTotaldegree(p);
5364  pLmDelete(p);
5365  if (d==1)
5366    res->data = (char *)pHomogen((poly)u->Data(),i);
5367  else
5368    WerrorS("variable must have weight 1");
5369  return (d!=1);
5370}
5371static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5372{
5373  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5374  intvec* arg = (intvec*) u->Data();
5375  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5376
5377  for (i=0; i<n; i++)
5378  {
5379    (*im)[i] = (*arg)[i];
5380  }
5381
5382  res->data = (char *)im;
5383  return FALSE;
5384}
5385static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5386{
5387  short *iw=iv2array((intvec *)w->Data());
5388  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5389  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
5390  return FALSE;
5391}
5392static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5393{
5394  if (!pIsUnit((poly)v->Data()))
5395  {
5396    WerrorS("2nd argument must be a unit");
5397    return TRUE;
5398  }
5399  res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
5400  return FALSE;
5401}
5402static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5403{
5404  res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
5405                             (intvec *)w->Data());
5406  return FALSE;
5407}
5408static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5409{
5410  if (!mpIsDiagUnit((matrix)v->Data()))
5411  {
5412    WerrorS("2nd argument must be a diagonal matrix of units");
5413    return TRUE;
5414  }
5415  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5416                               (matrix)v->CopyD());
5417  return FALSE;
5418}
5419static BOOLEAN currRingIsOverIntegralDomain ()
5420{
5421  /* true for fields and Z, false otherwise */
5422  if (rField_is_Ring_PtoM()) return FALSE;
5423  if (rField_is_Ring_2toM()) return FALSE;
5424  if (rField_is_Ring_ModN()) return FALSE;
5425  return TRUE;
5426}
5427static BOOLEAN jjMINOR_M(leftv res, leftv v)
5428{
5429  /* Here's the use pattern for the minor command:
5430        minor ( matrix_expression m, int_expression minorSize,
5431                optional ideal_expression IasSB, optional int_expression k,
5432                optional string_expression algorithm,
5433                optional int_expression cachedMinors,
5434                optional int_expression cachedMonomials )
5435     This method here assumes that there are at least two arguments.
5436     - If IasSB is present, it must be a std basis. All minors will be
5437       reduced w.r.t. IasSB.
5438     - If k is absent, all non-zero minors will be computed.
5439       If k is present and k > 0, the first k non-zero minors will be
5440       computed.
5441       If k is present and k < 0, the first |k| minors (some of which
5442       may be zero) will be computed.
5443       If k is present and k = 0, an error is reported.
5444     - If algorithm is absent, all the following arguments must be absent too.
5445       In this case, a heuristic picks the best-suited algorithm (among
5446       Bareiss, Laplace, and Laplace with caching).
5447       If algorithm is present, it must be one of "Bareiss", "bareiss",
5448       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5449       "cache" two more arguments may be given, determining how many entries
5450       the cache may have at most, and how many cached monomials there are at
5451       most. (Cached monomials are counted over all cached polynomials.)
5452       If these two additional arguments are not provided, 200 and 100000
5453       will be used as defaults.
5454  */
5455  matrix m;
5456  leftv u=v->next;
5457  v->next=NULL;
5458  int v_typ=v->Typ();
5459  if (v_typ==MATRIX_CMD)
5460  {
5461     m = (const matrix)v->Data();
5462  }
5463  else
5464  {
5465    if (v_typ==0)
5466    {
5467      Werror("`%s` is undefined",v->Fullname());
5468      return TRUE;
5469    }
5470    // try to convert to MATRIX:
5471    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5472    BOOLEAN bo;
5473    sleftv tmp;
5474    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5475    else bo=TRUE;
5476    if (bo)
5477    {
5478      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5479      return TRUE;
5480    }
5481    m=(matrix)tmp.data;
5482  }
5483  const int mk = (const int)(long)u->Data();
5484  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5485  bool noCacheMinors = true; bool noCacheMonomials = true;
5486  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5487
5488  /* here come the different cases of correct argument sets */
5489  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5490  {
5491    IasSB = (ideal)u->next->Data();
5492    noIdeal = false;
5493    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5494    {
5495      k = (int)(long)u->next->next->Data();
5496      noK = false;
5497      assume(k != 0);
5498      if ((u->next->next->next != NULL) &&
5499          (u->next->next->next->Typ() == STRING_CMD))
5500      {
5501        algorithm = (char*)u->next->next->next->Data();
5502        noAlgorithm = false;
5503        if ((u->next->next->next->next != NULL) &&
5504            (u->next->next->next->next->Typ() == INT_CMD))
5505        {
5506          cacheMinors = (int)(long)u->next->next->next->next->Data();
5507          noCacheMinors = false;
5508          if ((u->next->next->next->next->next != NULL) &&
5509              (u->next->next->next->next->next->Typ() == INT_CMD))
5510          {
5511            cacheMonomials =
5512               (int)(long)u->next->next->next->next->next->Data();
5513            noCacheMonomials = false;
5514          }
5515        }
5516      }
5517    }
5518  }
5519  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5520  {
5521    k = (int)(long)u->next->Data();
5522    noK = false;
5523    assume(k != 0);
5524    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5525    {
5526      algorithm = (char*)u->next->next->Data();
5527      noAlgorithm = false;
5528      if ((u->next->next->next != NULL) &&
5529          (u->next->next->next->Typ() == INT_CMD))
5530      {
5531        cacheMinors = (int)(long)u->next->next->next->Data();
5532        noCacheMinors = false;
5533        if ((u->next->next->next->next != NULL) &&
5534            (u->next->next->next->next->Typ() == INT_CMD))
5535        {
5536          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5537          noCacheMonomials = false;
5538        }
5539      }
5540    }
5541  }
5542  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5543  {
5544    algorithm = (char*)u->next->Data();
5545    noAlgorithm = false;
5546    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5547    {
5548      cacheMinors = (int)(long)u->next->next->Data();
5549      noCacheMinors = false;
5550      if ((u->next->next->next != NULL) &&
5551          (u->next->next->next->Typ() == INT_CMD))
5552      {
5553        cacheMonomials = (int)(long)u->next->next->next->Data();
5554        noCacheMonomials = false;
5555      }
5556    }
5557  }
5558
5559  /* upper case conversion for the algorithm if present */
5560  if (!noAlgorithm)
5561  {
5562    if (strcmp(algorithm, "bareiss") == 0)
5563      algorithm = (char*)"Bareiss";
5564    if (strcmp(algorithm, "laplace") == 0)
5565      algorithm = (char*)"Laplace";
5566    if (strcmp(algorithm, "cache") == 0)
5567      algorithm = (char*)"Cache";
5568  }
5569
5570  v->next=u;
5571  /* here come some tests */
5572  if (!noIdeal)
5573  {
5574    assumeStdFlag(u->next);
5575  }
5576  if ((!noK) && (k == 0))
5577  {
5578    WerrorS("Provided number of minors to be computed is zero.");
5579    return TRUE;
5580  }
5581  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
5582      && (strcmp(algorithm, "Laplace") != 0)
5583      && (strcmp(algorithm, "Cache") != 0))
5584  {
5585    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
5586    return TRUE;
5587  }
5588  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
5589      && (!currRingIsOverIntegralDomain()))
5590  {
5591    Werror("Bareiss algorithm not defined over coefficient rings %s",
5592           "with zero divisors.");
5593    return TRUE;
5594  }
5595  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
5596  {
5597    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
5598           m->rows(), m->cols());
5599    return TRUE;
5600  }
5601  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
5602      && (noCacheMinors || noCacheMonomials))
5603  {
5604    cacheMinors = 200;
5605    cacheMonomials = 100000;
5606  }
5607
5608  /* here come the actual procedure calls */
5609  if (noAlgorithm)
5610    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
5611                                       (noIdeal ? 0 : IasSB), false);
5612  else if (strcmp(algorithm, "Cache") == 0)
5613    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
5614                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
5615                                   cacheMonomials, false);
5616  else
5617    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
5618                              (noIdeal ? 0 : IasSB), false);
5619  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
5620  res->rtyp = IDEAL_CMD;
5621  return FALSE;
5622}
5623static BOOLEAN jjNEWSTRUCT3(leftv res, leftv u, leftv v, leftv w)
5624{
5625  // u: the name of the new type
5626  // v: the parent type
5627  // w: the elements
5628  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
5629                                            (const char *)w->Data());
5630  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
5631  return d==NULL;
5632}
5633static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
5634{
5635  // handles preimage(r,phi,i) and kernel(r,phi)
5636  idhdl h;
5637  ring rr;
5638  map mapping;
5639  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
5640
5641  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
5642  {
5643    WerrorS("2nd/3rd arguments must have names");
5644    return TRUE;
5645  }
5646  rr=(ring)u->Data();
5647  const char *ring_name=u->Name();
5648  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
5649  {
5650    if (h->typ==MAP_CMD)
5651    {
5652      mapping=IDMAP(h);
5653      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
5654      if ((preim_ring==NULL)
5655      || (IDRING(preim_ring)!=currRing))
5656      {
5657        Werror("preimage ring `%s` is not the basering",mapping->preimage);
5658        return TRUE;
5659      }
5660    }
5661    else if (h->typ==IDEAL_CMD)
5662    {
5663      mapping=IDMAP(h);
5664    }
5665    else
5666    {
5667      Werror("`%s` is no map nor ideal",IDID(h));
5668      return TRUE;
5669    }
5670  }
5671  else
5672  {
5673    Werror("`%s` is not defined in `%s`",v->name,ring_name);
5674    return TRUE;
5675  }
5676  ideal image;
5677  if (kernel_cmd) image=idInit(1,1);
5678  else
5679  {
5680    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
5681    {
5682      if (h->typ==IDEAL_CMD)
5683      {
5684        image=IDIDEAL(h);
5685      }
5686      else
5687      {
5688        Werror("`%s` is no ideal",IDID(h));
5689        return TRUE;
5690      }
5691    }
5692    else
5693    {
5694      Werror("`%s` is not defined in `%s`",w->name,ring_name);
5695      return TRUE;
5696    }
5697  }
5698  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
5699  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
5700  {
5701    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
5702  }
5703  res->data=(char *)maGetPreimage(rr,mapping,image);
5704  if (kernel_cmd) idDelete(&image);
5705  return (res->data==NULL/* is of type ideal, should not be NULL*/);
5706}
5707static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
5708{
5709  int di, k;
5710  int i=(int)(long)u->Data();
5711  int r=(int)(long)v->Data();
5712  int c=(int)(long)w->Data();
5713  if ((r<=0) || (c<=0)) return TRUE;
5714  intvec *iv = new intvec(r, c, 0);
5715  if (iv->rows()==0)
5716  {
5717    delete iv;
5718    return TRUE;
5719  }
5720  if (i!=0)
5721  {
5722    if (i<0) i = -i;
5723    di = 2 * i + 1;
5724    for (k=0; k<iv->length(); k++)
5725    {
5726      (*iv)[k] = ((siRand() % di) - i);
5727    }
5728  }
5729  res->data = (char *)iv;
5730  return FALSE;
5731}
5732static BOOLEAN jjSUBST_Test(leftv v,leftv w,
5733  int &ringvar, poly &monomexpr)
5734{
5735  monomexpr=(poly)w->Data();
5736  poly p=(poly)v->Data();
5737  #if 0
5738  if (pLength(monomexpr)>1)
5739  {
5740    Werror("`%s` substitutes a ringvar only by a term",
5741      Tok2Cmdname(SUBST_CMD));
5742    return TRUE;
5743  }
5744  #endif
5745  if (!(ringvar=pVar(p)))
5746  {
5747    if (rField_is_Extension(currRing))
5748    {
5749      assume(currRing->algring!=NULL);
5750      lnumber n=(lnumber)pGetCoeff(p);
5751      ringvar=-p_Var(n->z,currRing->algring);
5752    }
5753    if(ringvar==0)
5754    {
5755      WerrorS("ringvar/par expected");
5756      return TRUE;
5757    }
5758  }
5759  return FALSE;
5760}
5761static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
5762{
5763  int ringvar;
5764  poly monomexpr;
5765  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
5766  if (nok) return TRUE;
5767  poly p=(poly)u->Data();
5768  if (ringvar>0)
5769  {
5770    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
5771    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
5772    {
5773      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask);
5774      //return TRUE;
5775    }
5776    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
5777      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
5778    else
5779      res->data= pSubstPoly(p,ringvar,monomexpr);
5780  }
5781  else
5782  {
5783    res->data=pSubstPar(p,-ringvar,monomexpr);
5784  }
5785  return FALSE;
5786}
5787static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
5788{
5789  int ringvar;
5790  poly monomexpr;
5791  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
5792  if (nok) return TRUE;
5793  if (ringvar>0)
5794  {
5795    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
5796      res->data = idSubst((ideal)u->CopyD(res->rtyp),ringvar,monomexpr);
5797    else
5798      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
5799  }
5800  else
5801  {
5802    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
5803  }
5804  return FALSE;
5805}
5806// we do not want to have jjSUBST_Id_X inlined:
5807static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
5808                            int input_type);
5809static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
5810{
5811  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
5812}
5813static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
5814{
5815  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
5816}
5817static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
5818{
5819  sleftv tmp;
5820  memset(&tmp,0,sizeof(tmp));
5821  // do not check the result, conversion from int/number to poly works always
5822  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
5823  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
5824  tmp.CleanUp();
5825  return b;
5826}