source: git/Singular/iparith.cc @ 6c22988

spielwiese
Last change on this file since 6c22988 was 6c22988, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix tr. 318 git-svn-id: file:///usr/local/Singular/svn/trunk@13939 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 202.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: table driven kernel interface, used by interpreter
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <ctype.h>
13#include <stdio.h>
14#include <time.h>
15#include <unistd.h>
16
17#include <kernel/mod2.h>
18#include <Singular/tok.h>
19#include <kernel/options.h>
20#include <Singular/ipid.h>
21#include <kernel/intvec.h>
22#include <omalloc/omalloc.h>
23#include <kernel/polys.h>
24#include <kernel/febase.h>
25#include <Singular/sdb.h>
26#include <kernel/longalg.h>
27#include <kernel/longtrans.h>
28#include <kernel/ideals.h>
29#include <kernel/matpol.h>
30#include <kernel/kstd1.h>
31#include <kernel/timer.h>
32#include <kernel/ring.h>
33#include <Singular/subexpr.h>
34#include <Singular/lists.h>
35#include <kernel/modulop.h>
36#ifdef HAVE_RINGS
37#include <kernel/rmodulon.h>
38#include <kernel/rmodulo2m.h>
39#include <kernel/rintegers.h>
40#endif
41#include <kernel/numbers.h>
42#include <kernel/stairc.h>
43#include <kernel/maps.h>
44#include <Singular/maps_ip.h>
45#include <kernel/syz.h>
46#include <kernel/weight.h>
47#include <Singular/ipconv.h>
48#include <Singular/ipprint.h>
49#include <Singular/attrib.h>
50#include <Singular/silink.h>
51#include <kernel/sparsmat.h>
52#include <kernel/units.h>
53#include <Singular/janet.h>
54#include <kernel/GMPrat.h>
55#include <kernel/tgb.h>
56#include <kernel/walkProc.h>
57#include <kernel/mod_raw.h>
58#include <Singular/MinorInterface.h>
59#include <kernel/linearAlgebra.h>
60#include <Singular/misc_ip.h>
61#ifdef HAVE_FACTORY
62#  include <kernel/clapsing.h>
63#  include <kernel/kstdfac.h>
64#endif /* HAVE_FACTORY */
65#ifdef HAVE_FACTORY
66#  include <kernel/fglm.h>
67#endif /* HAVE_FACTORY */
68#include <Singular/interpolation.h>
69
70#include <Singular/blackbox.h>
71#include <Singular/newstruct.h>
72#include <Singular/ipshell.h>
73#include <kernel/mpr_inout.h>
74
75#include <kernel/timer.h>
76
77#ifdef HAVE_PLURAL
78  #include <kernel/gring.h>
79  #include <kernel/sca.h>
80  #define ALLOW_PLURAL     1
81  #define NO_PLURAL        0
82  #define COMM_PLURAL      2
83  #define  PLURAL_MASK 3
84#else /* HAVE_PLURAL */
85  #define ALLOW_PLURAL     0
86  #define NO_PLURAL        0
87  #define COMM_PLURAL      0
88  #define  PLURAL_MASK     0
89#endif /* HAVE_PLURAL */
90
91#ifdef HAVE_RINGS
92  #define RING_MASK        4
93#else
94  #define RING_MASK        0
95#endif
96#define ALLOW_RING       4
97#define NO_RING          0
98
99/*=============== types =====================*/
100struct sValCmdTab
101{
102  short cmd;
103  short start;
104};
105
106typedef sValCmdTab jjValCmdTab[];
107
108struct _scmdnames
109{
110  char *name;
111  short alias;
112  short tokval;
113  short toktype;
114};
115typedef struct _scmdnames cmdnames;
116
117
118typedef char * (*Proc1)(char *);
119struct sValCmd1
120{
121  proc1 p;
122  short cmd;
123  short res;
124  short arg;
125  short valid_for;
126};
127
128typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
129struct sValCmd2
130{
131  proc2 p;
132  short cmd;
133  short res;
134  short arg1;
135  short arg2;
136  short valid_for;
137};
138
139typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
140struct sValCmd3
141{
142  proc3 p;
143  short cmd;
144  short res;
145  short arg1;
146  short arg2;
147  short arg3;
148  short valid_for;
149};
150struct sValCmdM
151{
152  proc1 p;
153  short cmd;
154  short res;
155  short number_of_args; /* -1: any, -2: any >0, .. */
156  short valid_for;
157};
158
159typedef struct
160{
161  cmdnames *sCmds;             /**< array of existing commands */
162  struct sValCmd1 *psValCmd1;
163  struct sValCmd2 *psValCmd2;
164  struct sValCmd3 *psValCmd3;
165  struct sValCmdM *psValCmdM;
166  int nCmdUsed;      /**< number of commands used */
167  int nCmdAllocated; /**< number of commands-slots allocated */
168  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
169} SArithBase;
170
171/*---------------------------------------------------------------------*
172 * File scope Variables (Variables share by several functions in
173 *                       the same file )
174 *
175 *---------------------------------------------------------------------*/
176static SArithBase sArithBase;  /**< Base entry for arithmetic */
177
178/*---------------------------------------------------------------------*
179 * Extern Functions declarations
180 *
181 *---------------------------------------------------------------------*/
182static int _gentable_sort_cmds(const void *a, const void *b);
183extern int iiArithRemoveCmd(char *szName);
184extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
185                         short nToktype, short nPos=-1);
186
187/*============= proc =======================*/
188static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
189static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
190#ifdef MDEBUG
191#define jjMakeSub(A) jjDBMakeSub(A,__FILE__,__LINE__)
192static Subexpr jjDBMakeSub(leftv e,const char *f,const  int l);
193#else
194static Subexpr jjMakeSub(leftv e);
195#endif
196
197/*============= vars ======================*/
198extern int cmdtok;
199extern BOOLEAN expected_parms;
200
201#define ii_div_by_0 "div. by 0"
202#define ii_not_for_plural "not implemented for non-commutative rings"
203#define ii_not_for_ring "not implemented for rings with rings as coeffients"
204
205int iiOp; /* the current operation*/
206
207/*=================== operations with 2 args.: static proc =================*/
208/* must be ordered: first operations for chars (infix ops),
209 * then alphabetically */
210
211static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
212{
213  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
214  int bb = (int)(long)(v->Data());
215  if (errorreported) return TRUE;
216  switch (iiOp)
217  {
218    case '+': (*aa) += bb; break;
219    case '-': (*aa) -= bb; break;
220    case '*': (*aa) *= bb; break;
221    case '/':
222    case INTDIV_CMD: (*aa) /= bb; break;
223    case '%':
224    case INTMOD_CMD: (*aa) %= bb; break;
225  }
226  res->data=(char *)aa;
227  return FALSE;
228}
229static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
230{
231  return jjOP_IV_I(res,v,u);
232}
233static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
234{
235  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
236  int bb = (int)(long)(v->Data());
237  int i=si_min(aa->rows(),aa->cols());
238  switch (iiOp)
239  {
240    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
241              break;
242    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
243              break;
244  }
245  res->data=(char *)aa;
246  return FALSE;
247}
248static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
249{
250  return jjOP_IM_I(res,v,u);
251}
252static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
253{
254  int l=(int)(long)v->Data();
255  if (l>0)
256  {
257    int d=(int)(long)u->Data();
258    intvec *vv=new intvec(l);
259    int i;
260    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
261    res->data=(char *)vv;
262  }
263  return (l<=0);
264}
265static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
266{
267  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
268  return FALSE;
269}
270static void jjEQUAL_REST(leftv res,leftv u,leftv v);
271static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
272{
273  intvec*    a = (intvec * )(u->Data());
274  intvec*    b = (intvec * )(v->Data());
275  int r=a->compare(b);
276  switch  (iiOp)
277  {
278    case '<':
279      res->data  = (char *) (r<0);
280      break;
281    case '>':
282      res->data  = (char *) (r>0);
283      break;
284    case LE:
285      res->data  = (char *) (r<=0);
286      break;
287    case GE:
288      res->data  = (char *) (r>=0);
289      break;
290    case EQUAL_EQUAL:
291    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
292      res->data  = (char *) (r==0);
293      break;
294  }
295  jjEQUAL_REST(res,u,v);
296  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
297  return FALSE;
298}
299static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
300{
301  intvec* a = (intvec * )(u->Data());
302  int     b = (int)(long)(v->Data());
303  int r=a->compare(b);
304  switch  (iiOp)
305  {
306    case '<':
307      res->data  = (char *) (r<0);
308      break;
309    case '>':
310      res->data  = (char *) (r>0);
311      break;
312    case LE:
313      res->data  = (char *) (r<=0);
314      break;
315    case GE:
316      res->data  = (char *) (r>=0);
317      break;
318    case EQUAL_EQUAL:
319    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
320      res->data  = (char *) (r==0);
321      break;
322  }
323  jjEQUAL_REST(res,u,v);
324  return FALSE;
325}
326static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
327{
328  poly p=(poly)u->Data();
329  poly q=(poly)v->Data();
330  int r=pCmp(p,q);
331  if (r==0)
332  {
333    number h=nSub(pGetCoeff(p),pGetCoeff(q));
334    /* compare lead coeffs */
335    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
336    nDelete(&h);
337  }
338  else if (p==NULL)
339  {
340    if (q==NULL)
341    {
342      /* compare 0, 0 */
343      r=0;
344    }
345    else if(pIsConstant(q))
346    {
347      /* compare 0, const */
348      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
349    }
350  }
351  else if (q==NULL)
352  {
353    if (pIsConstant(p))
354    {
355      /* compare const, 0 */
356      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
357    }
358  }
359  switch  (iiOp)
360  {
361    case '<':
362      res->data  = (char *) (r < 0);
363      break;
364    case '>':
365      res->data  = (char *) (r > 0);
366      break;
367    case LE:
368      res->data  = (char *) (r <= 0);
369      break;
370    case GE:
371      res->data  = (char *) (r >= 0);
372      break;
373    //case EQUAL_EQUAL:
374    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
375    //  res->data  = (char *) (r == 0);
376    //  break;
377  }
378  jjEQUAL_REST(res,u,v);
379  return FALSE;
380}
381static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
382{
383  char*    a = (char * )(u->Data());
384  char*    b = (char * )(v->Data());
385  int result = strcmp(a,b);
386  switch  (iiOp)
387  {
388    case '<':
389      res->data  = (char *) (result  < 0);
390      break;
391    case '>':
392      res->data  = (char *) (result  > 0);
393      break;
394    case LE:
395      res->data  = (char *) (result  <= 0);
396      break;
397    case GE:
398      res->data  = (char *) (result  >= 0);
399      break;
400    case EQUAL_EQUAL:
401    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
402      res->data  = (char *) (result  == 0);
403      break;
404  }
405  jjEQUAL_REST(res,u,v);
406  return FALSE;
407}
408static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
409{
410  if (u->Next()!=NULL)
411  {
412    u=u->next;
413    res->next = (leftv)omAllocBin(sleftv_bin);
414    return iiExprArith2(res->next,u,iiOp,v);
415  }
416  else if (v->Next()!=NULL)
417  {
418    v=v->next;
419    res->next = (leftv)omAllocBin(sleftv_bin);
420    return iiExprArith2(res->next,u,iiOp,v);
421  }
422  return FALSE;
423}
424static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
425{
426  int b=(int)(long)u->Data();
427  int e=(int)(long)v->Data();
428  int rc = 1;
429  BOOLEAN overflow=FALSE;
430  if (e >= 0)
431  {
432    if (b==0)
433    {
434      rc=(e==0);
435    }
436    else
437    {
438      int oldrc;
439      while ((e--)!=0)
440      {
441        oldrc=rc;
442        rc *= b;
443        if (!overflow)
444        {
445          if(rc/b!=oldrc) overflow=TRUE;
446        }
447      }
448      if (overflow)
449        WarnS("int overflow(^), result may be wrong");
450    }
451    res->data = (char *)((long)rc);
452    if (u!=NULL) return jjOP_REST(res,u,v);
453    return FALSE;
454  }
455  else
456  {
457    WerrorS("exponent must be non-negative");
458    return TRUE;
459  }
460}
461static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
462{
463  int e=(int)(long)v->Data();
464  number n=(number)u->Data();
465  if (e>=0)
466  {
467    nlPower(n,e,(number*)&res->data);
468  }
469  else
470  {
471    WerrorS("exponent must be non-negative");
472    return TRUE;
473  }
474  if (u!=NULL) return jjOP_REST(res,u,v);
475  return FALSE;
476}
477static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
478{
479  int e=(int)(long)v->Data();
480  number n=(number)u->Data();
481  int d=0;
482  if (e<0)
483  {
484    n=nInvers(n);
485    e=-e;
486    d=1;
487  }
488  nPower(n,e,(number*)&res->data);
489  if (d) nDelete(&n);
490  if (u!=NULL) return jjOP_REST(res,u,v);
491  return FALSE;
492}
493static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
494{
495  int v_i=(int)(long)v->Data();
496  if (v_i<0)
497  {
498    WerrorS("exponent must be non-negative");
499    return TRUE;
500  }
501  poly u_p=(poly)u->CopyD(POLY_CMD);
502  int dummy;
503  if ((u_p!=NULL)
504  && (pTotaldegree(u_p)*(signed long)v_i > (signed long)currRing->bitmask))
505  {
506    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
507                                    pTotaldegree(u_p),v_i,currRing->bitmask);
508    pDelete(&u_p);
509    return TRUE;
510  }
511  res->data = (char *)pPower(u_p,v_i);
512  if (u!=NULL) return jjOP_REST(res,u,v);
513  return errorreported; /* pPower may set errorreported via Werror */
514}
515static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
516{
517  res->data = (char *)idPower((ideal)(u->Data()),(int)(long)(v->Data()));
518  if (u!=NULL) return jjOP_REST(res,u,v);
519  return FALSE;
520}
521static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
522{
523  u=u->next;
524  v=v->next;
525  if (u==NULL)
526  {
527    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
528    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
529    {
530      do
531      {
532        if (res->next==NULL)
533          res->next = (leftv)omAlloc0Bin(sleftv_bin);
534        leftv tmp_v=v->next;
535        v->next=NULL;
536        BOOLEAN b=iiExprArith1(res->next,v,'-');
537        v->next=tmp_v;
538        if (b)
539          return TRUE;
540        v=tmp_v;
541        res=res->next;
542      } while (v!=NULL);
543      return FALSE;
544    }
545    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
546    {
547      res->next = (leftv)omAlloc0Bin(sleftv_bin);
548      res=res->next;
549      res->data = v->CopyD();
550      res->rtyp = v->Typ();
551      v=v->next;
552      if (v==NULL) return FALSE;
553    }
554  }
555  if (v!=NULL)                     /* u<>NULL, v<>NULL */
556  {
557    do
558    {
559      res->next = (leftv)omAlloc0Bin(sleftv_bin);
560      leftv tmp_u=u->next; u->next=NULL;
561      leftv tmp_v=v->next; v->next=NULL;
562      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
563      u->next=tmp_u;
564      v->next=tmp_v;
565      if (b)
566        return TRUE;
567      u=tmp_u;
568      v=tmp_v;
569      res=res->next;
570    } while ((u!=NULL) && (v!=NULL));
571    return FALSE;
572  }
573  loop                             /* u<>NULL, v==NULL */
574  {
575    res->next = (leftv)omAlloc0Bin(sleftv_bin);
576    res=res->next;
577    res->data = u->CopyD();
578    res->rtyp = u->Typ();
579    u=u->next;
580    if (u==NULL) return FALSE;
581  }
582}
583static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
584{
585  idhdl packhdl;
586  switch(u->Typ())
587  {
588      case 0:
589        Print("%s of type 'ANY'. Trying load.\n", v->name);
590        if(iiTryLoadLib(u, u->name))
591        {
592          Werror("'%s' no such package", u->name);
593          return TRUE;
594        }
595        syMake(u,u->name,NULL);
596        // else: use next case !!! no break !!!
597      case PACKAGE_CMD:
598        packhdl = (idhdl)u->data;
599        if((!IDPACKAGE(packhdl)->loaded)
600        && (IDPACKAGE(packhdl)->language > LANG_TOP))
601        {
602          Werror("'%s' not loaded", u->name);
603          return TRUE;
604        }
605        if(v->rtyp == IDHDL)
606        {
607          v->name = omStrDup(v->name);
608        }
609        v->req_packhdl=IDPACKAGE(packhdl);
610        syMake(v, v->name, packhdl);
611        memcpy(res, v, sizeof(sleftv));
612        memset(v, 0, sizeof(sleftv));
613        break;
614      case DEF_CMD:
615        break;
616      default:
617        WerrorS("<package>::<id> expected");
618        return TRUE;
619  }
620  return FALSE;
621}
622static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
623{
624  unsigned int a=(unsigned int)(unsigned long)u->Data();
625  unsigned int b=(unsigned int)(unsigned long)v->Data();
626  unsigned int c=a+b;
627  res->data = (char *)((long)c);
628  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
629  {
630    WarnS("int overflow(+), result may be wrong");
631  }
632  return jjPLUSMINUS_Gen(res,u,v);
633}
634static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
635{
636  res->data = (char *)(nlAdd((number)u->Data(), (number)v->Data()));
637  return jjPLUSMINUS_Gen(res,u,v);
638}
639static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
640{
641  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
642  return jjPLUSMINUS_Gen(res,u,v);
643}
644static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
645{
646  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
647  return jjPLUSMINUS_Gen(res,u,v);
648}
649static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
650{
651  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
652  if (res->data==NULL)
653  {
654     WerrorS("intmat size not compatible");
655     return TRUE;
656  }
657  return jjPLUSMINUS_Gen(res,u,v);
658  return FALSE;
659}
660static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
661{
662  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
663  res->data = (char *)(mpAdd(A , B));
664  if (res->data==NULL)
665  {
666     Werror("matrix size not compatible(%dx%d, %dx%d)",
667             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
668     return TRUE;
669  }
670  return jjPLUSMINUS_Gen(res,u,v);
671}
672static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
673{
674  matrix m=(matrix)u->Data();
675  matrix p= mpInitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)));
676  if (iiOp=='+')
677    res->data = (char *)mpAdd(m , p);
678  else
679    res->data = (char *)mpSub(m , p);
680  idDelete((ideal *)&p);
681  return jjPLUSMINUS_Gen(res,u,v);
682}
683static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
684{
685  return jjPLUS_MA_P(res,v,u);
686}
687static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
688{
689  char*    a = (char * )(u->Data());
690  char*    b = (char * )(v->Data());
691  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
692  strcpy(r,a);
693  strcat(r,b);
694  res->data=r;
695  return jjPLUSMINUS_Gen(res,u,v);
696}
697static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
698{
699  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
700  return jjPLUSMINUS_Gen(res,u,v);
701}
702static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
703{
704  void *ap=u->Data(); void *bp=v->Data();
705  int aa=(int)(long)ap;
706  int bb=(int)(long)bp;
707  int cc=aa-bb;
708  unsigned int a=(unsigned int)(unsigned long)ap;
709  unsigned int b=(unsigned int)(unsigned long)bp;
710  unsigned int c=a-b;
711  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
712  {
713    WarnS("int overflow(-), result may be wrong");
714  }
715  res->data = (char *)((long)cc);
716  return jjPLUSMINUS_Gen(res,u,v);
717}
718static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
719{
720  res->data = (char *)(nlSub((number)u->Data(), (number)v->Data()));
721  return jjPLUSMINUS_Gen(res,u,v);
722}
723static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
724{
725  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
726  return jjPLUSMINUS_Gen(res,u,v);
727}
728static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
729{
730  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
731  return jjPLUSMINUS_Gen(res,u,v);
732}
733static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
734{
735  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
736  if (res->data==NULL)
737  {
738     WerrorS("intmat size not compatible");
739     return TRUE;
740  }
741  return jjPLUSMINUS_Gen(res,u,v);
742}
743static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
744{
745  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
746  res->data = (char *)(mpSub(A , B));
747  if (res->data==NULL)
748  {
749     Werror("matrix size not compatible(%dx%d, %dx%d)",
750             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
751     return TRUE;
752  }
753  return jjPLUSMINUS_Gen(res,u,v);
754  return FALSE;
755}
756static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
757{
758  int a=(int)(long)u->Data();
759  int b=(int)(long)v->Data();
760  int c=a * b;
761  if ((b!=0) && (c/b !=a))
762    WarnS("int overflow(*), result may be wrong");
763  res->data = (char *)((long)c);
764  if ((u->Next()!=NULL) || (v->Next()!=NULL))
765    return jjOP_REST(res,u,v);
766  return FALSE;
767}
768static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
769{
770  res->data = (char *)(nlMult( (number)u->Data(), (number)v->Data()));
771  if ((v->next!=NULL) || (u->next!=NULL))
772    return jjOP_REST(res,u,v);
773  return FALSE;
774}
775static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
776{
777  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
778  number n=(number)res->data;
779  nNormalize(n);
780  res->data=(char *)n;
781  if ((v->next!=NULL) || (u->next!=NULL))
782    return jjOP_REST(res,u,v);
783  return FALSE;
784}
785static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
786{
787  poly a;
788  poly b;
789  int dummy;
790  if (v->next==NULL)
791  {
792    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
793    if (u->next==NULL)
794    {
795      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
796      if ((a!=NULL) && (b!=NULL)
797      && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
798      {
799        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
800          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
801        pDelete(&a);
802        pDelete(&b);
803        return TRUE;
804      }
805      res->data = (char *)(pMult( a, b));
806      pNormalize((poly)res->data);
807      return FALSE;
808    }
809    // u->next exists: copy v
810    b=pCopy((poly)v->Data());
811    if ((a!=NULL) && (b!=NULL)
812    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
813    {
814      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
815          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
816      pDelete(&a);
817      pDelete(&b);
818      return TRUE;
819    }
820    res->data = (char *)(pMult( a, b));
821    pNormalize((poly)res->data);
822    return jjOP_REST(res,u,v);
823  }
824  // v->next exists: copy u
825  a=pCopy((poly)u->Data());
826  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
827  if ((a!=NULL) && (b!=NULL)
828  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
829  {
830    pDelete(&a);
831    pDelete(&b);
832    WerrorS("OVERFLOW");
833    return TRUE;
834  }
835  res->data = (char *)(pMult( a, b));
836  pNormalize((poly)res->data);
837  return jjOP_REST(res,u,v);
838}
839static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
840{
841  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
842  idNormalize((ideal)res->data);
843  if ((v->next!=NULL) || (u->next!=NULL))
844    return jjOP_REST(res,u,v);
845  return FALSE;
846}
847static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
848{
849  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
850  if (res->data==NULL)
851  {
852     WerrorS("intmat size not compatible");
853     return TRUE;
854  }
855  if ((v->next!=NULL) || (u->next!=NULL))
856    return jjOP_REST(res,u,v);
857  return FALSE;
858}
859static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
860{
861  number n=nInit_bigint((number)v->Data());
862  poly p=pNSet(n);
863  ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
864  res->data = (char *)I;
865  return FALSE;
866}
867static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
868{
869  return jjTIMES_MA_BI1(res,v,u);
870}
871static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
872{
873  poly p=(poly)v->CopyD(POLY_CMD);
874  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
875  ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
876  if (r>0) I->rank=r;
877  idNormalize(I);
878  res->data = (char *)I;
879  return FALSE;
880}
881static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
882{
883  poly p=(poly)u->CopyD(POLY_CMD);
884  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
885  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD));
886  if (r>0) I->rank=r;
887  idNormalize(I);
888  res->data = (char *)I;
889  return FALSE;
890}
891static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
892{
893  number n=(number)v->CopyD(NUMBER_CMD);
894  poly p=pNSet(n);
895  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
896  idNormalize((ideal)res->data);
897  return FALSE;
898}
899static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
900{
901  return jjTIMES_MA_N1(res,v,u);
902}
903static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
904{
905  res->data = (char *)mpMultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data());
906  idNormalize((ideal)res->data);
907  return FALSE;
908}
909static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
910{
911  return jjTIMES_MA_I1(res,v,u);
912}
913static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
914{
915  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
916  res->data = (char *)mpMult(A,B);
917  if (res->data==NULL)
918  {
919     Werror("matrix size not compatible(%dx%d, %dx%d)",
920             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
921     return TRUE;
922  }
923  idNormalize((ideal)res->data);
924  if ((v->next!=NULL) || (u->next!=NULL))
925    return jjOP_REST(res,u,v);
926  return FALSE;
927}
928static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
929{
930  number h=nlSub((number)u->Data(),(number)v->Data());
931  res->data = (char *) (nlGreaterZero(h)||(nlIsZero(h)));
932  nlDelete(&h,NULL);
933  return FALSE;
934}
935static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
936{
937  res->data = (char *)((int)((long)u->Data()) >= (int)((long)v->Data()));
938  return FALSE;
939}
940static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
941{
942  res->data = (char *) (nGreater((number)u->Data(),(number)v->Data())
943                       || nEqual((number)u->Data(),(number)v->Data()));
944  return FALSE;
945}
946static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
947{
948  number h=nlSub((number)u->Data(),(number)v->Data());
949  res->data = (char *) (nlGreaterZero(h)&&(!nlIsZero(h)));
950  nlDelete(&h,NULL);
951  return FALSE;
952}
953static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
954{
955  res->data = (char *)((int)((long)u->Data()) > (int)((long)v->Data()));
956  return FALSE;
957}
958static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
959{
960  res->data = (char *) (nGreater((number)u->Data(),(number)v->Data()));
961  return FALSE;
962}
963static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
964{
965  return jjGE_BI(res,v,u);
966}
967static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
968{
969  res->data = (char *)((int)((long)u->Data()) <= (int)((long)v->Data()));
970  return FALSE;
971}
972static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
973{
974  return jjGE_N(res,v,u);
975}
976static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
977{
978  return jjGT_BI(res,v,u);
979}
980static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
981{
982  res->data = (char *)((int)((long)u->Data()) < (int)((long)v->Data()));
983  return FALSE;
984}
985static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
986{
987  return jjGT_N(res,v,u);
988}
989static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
990{
991  int a= (int)(long)u->Data();
992  int b= (int)(long)v->Data();
993  if (b==0)
994  {
995    WerrorS(ii_div_by_0);
996    return TRUE;
997  }
998  int bb=ABS(b);
999  int c=a%bb;
1000  if(c<0) c+=bb;
1001  int r=0;
1002  switch (iiOp)
1003  {
1004    case INTMOD_CMD:
1005        r=c;            break;
1006    case '%':
1007        r= (a % b);     break;
1008    case INTDIV_CMD:
1009        r=((a-c) /b);   break;
1010    case '/':
1011        r= (a / b);     break;
1012  }
1013  res->data=(void *)((long)r);
1014  return FALSE;
1015}
1016static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1017{
1018  number q=(number)v->Data();
1019  if (nlIsZero(q))
1020  {
1021    WerrorS(ii_div_by_0);
1022    return TRUE;
1023  }
1024  q = nlIntDiv((number)u->Data(),q);
1025  nlNormalize(q);
1026  res->data = (char *)q;
1027  return FALSE;
1028}
1029static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1030{
1031  number q=(number)v->Data();
1032  if (nIsZero(q))
1033  {
1034    WerrorS(ii_div_by_0);
1035    return TRUE;
1036  }
1037  q = nDiv((number)u->Data(),q);
1038  nNormalize(q);
1039  res->data = (char *)q;
1040  return FALSE;
1041}
1042static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1043{
1044  poly q=(poly)v->Data();
1045  if (q==NULL)
1046  {
1047    WerrorS(ii_div_by_0);
1048    return TRUE;
1049  }
1050  poly p=(poly)(u->Data());
1051  if (p==NULL)
1052  {
1053    res->data=NULL;
1054    return FALSE;
1055  }
1056  if ((pNext(q)!=NULL) && (!rField_is_Ring()))
1057  { /* This means that q != 0 consists of at least two terms.
1058       Moreover, currRing is over a field. */
1059#ifdef HAVE_FACTORY
1060    if(pGetComp(p)==0)
1061    {
1062      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1063                                         q /*(poly)(v->Data())*/ ));
1064    }
1065    else
1066    {
1067      int comps=pMaxComp(p);
1068      ideal I=idInit(comps,1);
1069      p=pCopy(p);
1070      poly h;
1071      int i;
1072      // conversion to a list of polys:
1073      while (p!=NULL)
1074      {
1075        i=pGetComp(p)-1;
1076        h=pNext(p);
1077        pNext(p)=NULL;
1078        pSetComp(p,0);
1079        I->m[i]=pAdd(I->m[i],p);
1080        p=h;
1081      }
1082      // division and conversion to vector:
1083      h=NULL;
1084      p=NULL;
1085      for(i=comps-1;i>=0;i--)
1086      {
1087        if (I->m[i]!=NULL)
1088        {
1089          h=singclap_pdivide(I->m[i],q);
1090          pSetCompP(h,i+1);
1091          p=pAdd(p,h);
1092        }
1093      }
1094      idDelete(&I);
1095      res->data=(void *)p;
1096    }
1097#else /* HAVE_FACTORY */
1098    WerrorS("division only by a monomial");
1099    return TRUE;
1100#endif /* HAVE_FACTORY */
1101  }
1102  else
1103  { /* This means that q != 0 consists of just one term,
1104       or that currRing is over a coefficient ring. */
1105#ifdef HAVE_RINGS
1106    if (!rField_is_Domain())
1107    {
1108      WerrorS("division only defined over coefficient domains");
1109      return TRUE;
1110    }
1111    if (pNext(q)!=NULL)
1112    {
1113      WerrorS("division over a coefficient domain only implemented for terms");
1114      return TRUE;
1115    }
1116#endif
1117    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1118  }
1119  pNormalize((poly)res->data);
1120  return FALSE;
1121}
1122static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1123{
1124  poly q=(poly)v->Data();
1125  if (q==NULL)
1126  {
1127    WerrorS(ii_div_by_0);
1128    return TRUE;
1129  }
1130  matrix m=(matrix)(u->Data());
1131  int r=m->rows();
1132  int c=m->cols();
1133  matrix mm=mpNew(r,c);
1134  int i,j;
1135  for(i=r;i>0;i--)
1136  {
1137    for(j=c;j>0;j--)
1138    {
1139      if (pNext(q)!=NULL)
1140      {
1141      #ifdef HAVE_FACTORY
1142        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1143                                           q /*(poly)(v->Data())*/ );
1144#else /* HAVE_FACTORY */
1145        WerrorS("division only by a monomial");
1146        return TRUE;
1147#endif /* HAVE_FACTORY */
1148      }
1149      else
1150        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1151    }
1152  }
1153  idNormalize((ideal)mm);
1154  res->data=(char *)mm;
1155  return FALSE;
1156}
1157static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1158{
1159  res->data = (char *)((long)nlEqual((number)u->Data(),(number)v->Data()));
1160  jjEQUAL_REST(res,u,v);
1161  return FALSE;
1162}
1163static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1164{
1165  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1166  jjEQUAL_REST(res,u,v);
1167  return FALSE;
1168}
1169static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1170{
1171  res->data = (char *)((long)mpEqual((matrix)u->Data(),(matrix)v->Data()));
1172  jjEQUAL_REST(res,u,v);
1173  return FALSE;
1174}
1175static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1176{
1177  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1178  jjEQUAL_REST(res,u,v);
1179  return FALSE;
1180}
1181static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1182{
1183  poly p=(poly)u->Data();
1184  poly q=(poly)v->Data();
1185  res->data = (char *) ((long)pEqualPolys(p,q));
1186  jjEQUAL_REST(res,u,v);
1187  return FALSE;
1188}
1189static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1190{
1191  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1192  {
1193    int save_iiOp=iiOp;
1194    if (iiOp==NOTEQUAL)
1195      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1196    else
1197      iiExprArith2(res,u->next,iiOp,v->next);
1198    iiOp=save_iiOp;
1199  }
1200  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1201}
1202static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1203{
1204  res->data = (char *)((long)u->Data() && (long)v->Data());
1205  return FALSE;
1206}
1207static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1208{
1209  res->data = (char *)((long)u->Data() || (long)v->Data());
1210  return FALSE;
1211}
1212static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1213{
1214  res->rtyp=u->rtyp; u->rtyp=0;
1215  res->data=u->data; u->data=NULL;
1216  res->name=u->name; u->name=NULL;
1217  res->e=u->e;       u->e=NULL;
1218  if (res->e==NULL) res->e=jjMakeSub(v);
1219  else
1220  {
1221    Subexpr sh=res->e;
1222    while (sh->next != NULL) sh=sh->next;
1223    sh->next=jjMakeSub(v);
1224  }
1225  return FALSE;
1226}
1227static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1228{
1229  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1230  {
1231    WerrorS("indexed object must have a name");
1232    return TRUE;
1233  }
1234  intvec * iv=(intvec *)v->Data();
1235  leftv p=NULL;
1236  int i;
1237  sleftv t;
1238  memset(&t,0,sizeof(t));
1239  t.rtyp=INT_CMD;
1240  for (i=0;i<iv->length(); i++)
1241  {
1242    t.data=(char *)((long)(*iv)[i]);
1243    if (p==NULL)
1244    {
1245      p=res;
1246    }
1247    else
1248    {
1249      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1250      p=p->next;
1251    }
1252    p->rtyp=IDHDL;
1253    p->data=u->data;
1254    p->name=u->name;
1255    p->flag=u->flag;
1256    p->e=jjMakeSub(&t);
1257  }
1258  u->rtyp=0;
1259  u->data=NULL;
1260  u->name=NULL;
1261  return FALSE;
1262}
1263static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1264{
1265  poly p=(poly)u->Data();
1266  int i=(int)(long)v->Data();
1267  int j=0;
1268  while (p!=NULL)
1269  {
1270    j++;
1271    if (j==i)
1272    {
1273      res->data=(char *)pHead(p);
1274      return FALSE;
1275    }
1276    pIter(p);
1277  }
1278  return FALSE;
1279}
1280static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1281{
1282  poly p=(poly)u->Data();
1283  poly r=NULL;
1284  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1285  int i;
1286  int sum=0;
1287  for(i=iv->length()-1;i>=0;i--)
1288    sum+=(*iv)[i];
1289  int j=0;
1290  while ((p!=NULL) && (sum>0))
1291  {
1292    j++;
1293    for(i=iv->length()-1;i>=0;i--)
1294    {
1295      if (j==(*iv)[i])
1296      {
1297        r=pAdd(r,pHead(p));
1298        sum-=j;
1299        (*iv)[i]=0;
1300        break;
1301      }
1302    }
1303    pIter(p);
1304  }
1305  delete iv;
1306  res->data=(char *)r;
1307  return FALSE;
1308}
1309static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1310{
1311  poly p=(poly)u->CopyD(VECTOR_CMD);
1312  poly r=p; // pointer to the beginning of component i
1313  poly o=NULL;
1314  int i=(int)(long)v->Data();
1315  while (p!=NULL)
1316  {
1317    if (pGetComp(p)!=i)
1318    {
1319      if (r==p) r=pNext(p);
1320      if (o!=NULL)
1321      {
1322        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1323        p=pNext(o);
1324      }
1325      else
1326        pLmDelete(&p);
1327    }
1328    else
1329    {
1330      pSetComp(p, 0);
1331      p_SetmComp(p, currRing);
1332      o=p;
1333      p=pNext(o);
1334    }
1335  }
1336  res->data=(char *)r;
1337  return FALSE;
1338}
1339static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1340{
1341  poly p=(poly)u->CopyD(VECTOR_CMD);
1342  if (p!=NULL)
1343  {
1344    poly r=pOne();
1345    poly hp=r;
1346    intvec *iv=(intvec *)v->Data();
1347    int i;
1348    loop
1349    {
1350      for(i=0;i<iv->length();i++)
1351      {
1352        if (pGetComp(p)==(*iv)[i])
1353        {
1354          poly h;
1355          pSplit(p,&h);
1356          pNext(hp)=p;
1357          p=h;
1358          pIter(hp);
1359          break;
1360        }
1361      }
1362      if (p==NULL) break;
1363      if (i==iv->length())
1364      {
1365        pLmDelete(&p);
1366        if (p==NULL) break;
1367      }
1368    }
1369    pLmDelete(&r);
1370    res->data=(char *)r;
1371  }
1372  return FALSE;
1373}
1374static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1375static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1376{
1377  if(u->name==NULL) return TRUE;
1378  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1379  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1380  omFree((ADDRESS)u->name);
1381  u->name=NULL;
1382  char *n=omStrDup(nn);
1383  omFree((ADDRESS)nn);
1384  syMake(res,n);
1385  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1386  return FALSE;
1387}
1388static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1389{
1390  intvec * iv=(intvec *)v->Data();
1391  leftv p=NULL;
1392  int i;
1393  long slen = strlen(u->name) + 14;
1394  char *n = (char*) omAlloc(slen);
1395
1396  for (i=0;i<iv->length(); i++)
1397  {
1398    if (p==NULL)
1399    {
1400      p=res;
1401    }
1402    else
1403    {
1404      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1405      p=p->next;
1406    }
1407    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1408    syMake(p,omStrDup(n));
1409  }
1410  omFree((ADDRESS)u->name);
1411  u->name = NULL;
1412  omFreeSize(n, slen);
1413  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1414  return FALSE;
1415}
1416static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1417{
1418  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1419  memset(tmp,0,sizeof(sleftv));
1420  BOOLEAN b;
1421  if (v->Typ()==INTVEC_CMD)
1422    b=jjKLAMMER_IV(tmp,u,v);
1423  else
1424    b=jjKLAMMER(tmp,u,v);
1425  if (b)
1426  {
1427    omFreeBin(tmp,sleftv_bin);
1428    return TRUE;
1429  }
1430  leftv h=res;
1431  while (h->next!=NULL) h=h->next;
1432  h->next=tmp;
1433  return FALSE;
1434}
1435BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1436{
1437  void *d;
1438  Subexpr e;
1439  int typ;
1440  BOOLEAN t=FALSE;
1441  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1442  {
1443    idrec tmp_proc;
1444    tmp_proc.id="_auto";
1445    tmp_proc.typ=PROC_CMD;
1446    tmp_proc.data.pinf=(procinfo *)u->Data();
1447    tmp_proc.ref=1;
1448    d=u->data; u->data=(void *)&tmp_proc;
1449    e=u->e; u->e=NULL;
1450    t=TRUE;
1451    typ=u->rtyp; u->rtyp=IDHDL;
1452  }
1453  leftv sl;
1454  if (u->req_packhdl==currPack)
1455    sl = iiMake_proc((idhdl)u->data,NULL,v);
1456  else
1457    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1458  if (t)
1459  {
1460    u->rtyp=typ;
1461    u->data=d;
1462    u->e=e;
1463  }
1464  if (sl==NULL)
1465  {
1466    return TRUE;
1467  }
1468  else
1469  {
1470    memcpy(res,sl,sizeof(sleftv));
1471  }
1472  return FALSE;
1473}
1474static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1475{
1476  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1477  leftv sl=NULL;
1478  if ((v->e==NULL)&&(v->name!=NULL))
1479  {
1480    map m=(map)u->Data();
1481    sl=iiMap(m,v->name);
1482  }
1483  else
1484  {
1485    Werror("%s(<name>) expected",u->Name());
1486  }
1487  if (sl==NULL) return TRUE;
1488  memcpy(res,sl,sizeof(sleftv));
1489  omFreeBin((ADDRESS)sl, sleftv_bin);
1490  return FALSE;
1491}
1492static BOOLEAN jjCALL2MANY(leftv res, leftv u, leftv v)
1493{
1494  u->next=(leftv)omAllocBin(sleftv_bin);
1495  memcpy(u->next,v,sizeof(sleftv));
1496  BOOLEAN r=iiExprArithM(res,u,iiOp);
1497  v->Init();
1498  // iiExprArithM did the CleanUp
1499  return r;
1500}
1501#ifdef HAVE_FACTORY
1502static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1503{
1504  if (rField_is_Q())
1505  {
1506    intvec *c=(intvec*)u->Data();
1507    intvec* p=(intvec*)v->Data();
1508    int rl=p->length();
1509    number *x=(number *)omAlloc(rl*sizeof(number));
1510    number *q=(number *)omAlloc(rl*sizeof(number));
1511    int i;
1512    for(i=rl-1;i>=0;i--)
1513    {
1514      q[i]=nlInit((*p)[i], NULL);
1515      x[i]=nlInit((*c)[i], NULL);
1516    }
1517    number n=nlChineseRemainder(x,q,rl);
1518    for(i=rl-1;i>=0;i--)
1519    {
1520      nlDelete(&(q[i]),NULL);
1521      nlDelete(&(x[i]),NULL);
1522    }
1523    omFree(x); omFree(q);
1524    res->data=(char *)n;
1525    return FALSE;
1526  }
1527  else return TRUE;
1528}
1529#endif
1530#if 0
1531static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1532{
1533  lists c=(lists)u->CopyD(); // list of poly
1534  intvec* p=(intvec*)v->Data();
1535  int rl=p->length();
1536  poly r=NULL,h, result=NULL;
1537  number *x=(number *)omAlloc(rl*sizeof(number));
1538  number *q=(number *)omAlloc(rl*sizeof(number));
1539  int i;
1540  for(i=rl-1;i>=0;i--)
1541  {
1542    q[i]=nlInit((*p)[i]);
1543  }
1544  loop
1545  {
1546    for(i=rl-1;i>=0;i--)
1547    {
1548      if (c->m[i].Typ()!=POLY_CMD)
1549      {
1550        Werror("poly expected at pos %d",i+1);
1551        for(i=rl-1;i>=0;i--)
1552        {
1553          nlDelete(&(q[i]),currRing);
1554        }
1555        omFree(x); omFree(q); // delete c
1556        return TRUE;
1557      }
1558      h=((poly)c->m[i].Data());
1559      if (r==NULL) r=h;
1560      else if (pLmCmp(r,h)==-1) r=h;
1561    }
1562    if (r==NULL) break;
1563    for(i=rl-1;i>=0;i--)
1564    {
1565      h=((poly)c->m[i].Data());
1566      if (pLmCmp(r,h)==0)
1567      {
1568        x[i]=pGetCoeff(h);
1569        h=pLmFreeAndNext(h);
1570        c->m[i].data=(char*)h;
1571      }
1572      else
1573        x[i]=nlInit(0);
1574    }
1575    number n=nlChineseRemainder(x,q,rl);
1576    for(i=rl-1;i>=0;i--)
1577    {
1578      nlDelete(&(x[i]),currRing);
1579    }
1580    h=pHead(r);
1581    pSetCoeff(h,n);
1582    result=pAdd(result,h);
1583  }
1584  for(i=rl-1;i>=0;i--)
1585  {
1586    nlDelete(&(q[i]),currRing);
1587  }
1588  omFree(x); omFree(q);
1589  res->data=(char *)result;
1590  return FALSE;
1591}
1592#endif
1593#ifdef HAVE_FACTORY
1594static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1595{
1596  if (rField_is_Q())
1597  {
1598    lists c=(lists)u->CopyD(); // list of ideal
1599    lists pl=NULL;
1600    intvec *p=NULL;
1601    if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1602    else                    p=(intvec*)v->Data();
1603    int rl=c->nr+1;
1604    poly r=NULL,h;
1605    ideal result;
1606    ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1607    int i;
1608    int return_type=c->m[0].Typ();
1609    if ((return_type!=IDEAL_CMD)
1610    && (return_type!=MODUL_CMD)
1611    && (return_type!=MATRIX_CMD))
1612    {
1613      WerrorS("ideal/module/matrix expected");
1614      omFree(x); // delete c
1615      return TRUE;
1616    }
1617    for(i=rl-1;i>=0;i--)
1618    {
1619      if (c->m[i].Typ()!=return_type)
1620      {
1621        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1622        omFree(x); // delete c
1623        return TRUE;
1624      }
1625      x[i]=((ideal)c->m[i].Data());
1626    }
1627    number *q=(number *)omAlloc(rl*sizeof(number));
1628    if (p!=NULL)
1629    {
1630      for(i=rl-1;i>=0;i--)
1631      {
1632        q[i]=nlInit((*p)[i], currRing);
1633      }
1634    }
1635    else
1636    {
1637      for(i=rl-1;i>=0;i--)
1638      {
1639        if (pl->m[i].Typ()==INT_CMD)
1640        {
1641          q[i]=nlInit((int)(long)pl->m[i].Data(),currRing);
1642        }
1643        else if (pl->m[i].Typ()==BIGINT_CMD)
1644        {
1645          q[i]=nlCopy((number)(pl->m[i].Data()));
1646        }
1647        else
1648        {
1649          Werror("bigint expected at pos %d",i+1);
1650          for(i++;i<rl;i++)
1651          {
1652            nlDelete(&(q[i]),currRing);
1653          }
1654          omFree(x); // delete c
1655          omFree(q); // delete pl
1656          return TRUE;
1657        }
1658      }
1659    }
1660    result=idChineseRemainder(x,q,rl);
1661    for(i=rl-1;i>=0;i--)
1662    {
1663      nlDelete(&(q[i]),currRing);
1664    }
1665    omFree(q);
1666    res->data=(char *)result;
1667    res->rtyp=return_type;
1668    return FALSE;
1669  }
1670  else return TRUE;
1671}
1672#endif
1673static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1674{
1675  poly p=(poly)v->Data();
1676  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1677  res->data=(char *)mpCoeffProc((poly)u->Data(),p /*(poly)v->Data()*/);
1678  return FALSE;
1679}
1680static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1681{
1682  int i=pVar((poly)v->Data());
1683  if (i==0)
1684  {
1685    WerrorS("ringvar expected");
1686    return TRUE;
1687  }
1688  res->data=(char *)mpCoeffs((ideal)u->CopyD(),i);
1689  return FALSE;
1690}
1691static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1692{
1693  poly p = pInit();
1694  int i;
1695  for (i=1; i<=pVariables; i++)
1696  {
1697    pSetExp(p, i, 1);
1698  }
1699  pSetm(p);
1700  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1701                                    (ideal)(v->Data()), p);
1702  pDelete(&p);
1703  return FALSE;
1704}
1705static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1706{
1707  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1708  return FALSE;
1709}
1710static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1711{
1712  short *iv=iv2array((intvec *)v->Data());
1713  ideal I=(ideal)u->Data();
1714  int d=-1;
1715  int i;
1716  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1717  omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1718  res->data = (char *)((long)d);
1719  return FALSE;
1720}
1721static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1722{
1723  poly p=(poly)u->Data();
1724  if (p!=NULL)
1725  {
1726    short *iv=iv2array((intvec *)v->Data());
1727    int d=(int)pDegW(p,iv);
1728    omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1729    res->data = (char *)(long(d));
1730  }
1731  else
1732    res->data=(char *)(long)(-1);
1733  return FALSE;
1734}
1735static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1736{
1737  int i=pVar((poly)v->Data());
1738  if (i==0)
1739  {
1740    WerrorS("ringvar expected");
1741    return TRUE;
1742  }
1743  res->data=(char *)pDiff((poly)(u->Data()),i);
1744  return FALSE;
1745}
1746static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1747{
1748  int i=pVar((poly)v->Data());
1749  if (i==0)
1750  {
1751    WerrorS("ringvar expected");
1752    return TRUE;
1753  }
1754  res->data=(char *)idDiff((matrix)(u->Data()),i);
1755  return FALSE;
1756}
1757static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1758{
1759  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1760  return FALSE;
1761}
1762static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1763{
1764  assumeStdFlag(v);
1765  if(currQuotient==NULL)
1766    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1767  else
1768  {
1769    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1770    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1771    idDelete(&q);
1772  }
1773  return FALSE;
1774}
1775static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1776{
1777  ideal vi=(ideal)v->Data();
1778  int vl= IDELEMS(vi);
1779  ideal ui=(ideal)u->Data();
1780  int ul= IDELEMS(ui);
1781  ideal R; matrix U;
1782  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1783  // now make sure that all matices have the corect size:
1784  matrix T = idModule2formatedMatrix(m,vl,ul);
1785  int i;
1786  if (MATCOLS(U) != ul)
1787  {
1788    int mul=si_min(ul,MATCOLS(U));
1789    matrix UU=mpNew(ul,ul);
1790    int j;
1791    for(i=mul;i>0;i--)
1792    {
1793      for(j=mul;j>0;j--)
1794      {
1795        MATELEM(UU,i,j)=MATELEM(U,i,j);
1796        MATELEM(U,i,j)=NULL;
1797      }
1798    }
1799    idDelete((ideal *)&U);
1800    U=UU;
1801  }
1802  // make sure that U is a diagonal matrix of units
1803  for(i=ul;i>0;i--)
1804  {
1805    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1806  }
1807  lists L=(lists)omAllocBin(slists_bin);
1808  L->Init(3);
1809  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1810  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1811  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1812  res->data=(char *)L;
1813  return FALSE;
1814}
1815static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1816{
1817  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1818  //setFlag(res,FLAG_STD);
1819  return FALSE;
1820}
1821static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1822{
1823  poly p=pOne();
1824  intvec *iv=(intvec*)v->Data();
1825  for(int i=iv->length()-1; i>=0; i--)
1826  {
1827    pSetExp(p,(*iv)[i],1);
1828  }
1829  pSetm(p);
1830  res->data=(char *)idElimination((ideal)u->Data(),p);
1831  pLmDelete(&p);
1832  //setFlag(res,FLAG_STD);
1833  return FALSE;
1834}
1835static BOOLEAN jjEXPORTTO(leftv res, leftv u, leftv v)
1836{
1837  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1838  return iiExport(v,0,(idhdl)u->data);
1839}
1840static BOOLEAN jjERROR(leftv res, leftv u)
1841{
1842  WerrorS((char *)u->Data());
1843  extern int inerror;
1844  inerror=3;
1845  return TRUE;
1846}
1847static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1848{
1849  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1850  int p0=ABS(uu),p1=ABS(vv);
1851  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1852
1853  while ( p1!=0 )
1854  {
1855    q=p0 / p1;
1856    r=p0 % p1;
1857    p0 = p1; p1 = r;
1858    r = g0 - g1 * q;
1859    g0 = g1; g1 = r;
1860    r = f0 - f1 * q;
1861    f0 = f1; f1 = r;
1862  }
1863  int a = f0;
1864  int b = g0;
1865  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
1866  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
1867  lists L=(lists)omAllocBin(slists_bin);
1868  L->Init(3);
1869  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
1870  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
1871  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
1872  res->rtyp=LIST_CMD;
1873  res->data=(char *)L;
1874  return FALSE;
1875}
1876#ifdef HAVE_FACTORY
1877static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
1878{
1879  poly r,pa,pb;
1880  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb);
1881  if (ret) return TRUE;
1882  lists L=(lists)omAllocBin(slists_bin);
1883  L->Init(3);
1884  res->data=(char *)L;
1885  L->m[0].data=(void *)r;
1886  L->m[0].rtyp=POLY_CMD;
1887  L->m[1].data=(void *)pa;
1888  L->m[1].rtyp=POLY_CMD;
1889  L->m[2].data=(void *)pb;
1890  L->m[2].rtyp=POLY_CMD;
1891  return FALSE;
1892}
1893extern int singclap_factorize_retry;
1894static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
1895{
1896  intvec *v=NULL;
1897  int sw=(int)(long)dummy->Data();
1898  int fac_sw=sw;
1899  if ((sw<0)||(sw>2)) fac_sw=1;
1900  singclap_factorize_retry=0;
1901  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw);
1902  if (f==NULL)
1903    return TRUE;
1904  switch(sw)
1905  {
1906    case 0:
1907    case 2:
1908    {
1909      lists l=(lists)omAllocBin(slists_bin);
1910      l->Init(2);
1911      l->m[0].rtyp=IDEAL_CMD;
1912      l->m[0].data=(void *)f;
1913      l->m[1].rtyp=INTVEC_CMD;
1914      l->m[1].data=(void *)v;
1915      res->data=(void *)l;
1916      res->rtyp=LIST_CMD;
1917      return FALSE;
1918    }
1919    case 1:
1920      res->data=(void *)f;
1921      return FALSE;
1922    case 3:
1923      {
1924        poly p=f->m[0];
1925        int i=IDELEMS(f);
1926        f->m[0]=NULL;
1927        while(i>1)
1928        {
1929          i--;
1930          p=pMult(p,f->m[i]);
1931          f->m[i]=NULL;
1932        }
1933        res->data=(void *)p;
1934        res->rtyp=POLY_CMD;
1935      }
1936      return FALSE;
1937  }
1938  WerrorS("invalid switch");
1939  return TRUE;
1940}
1941static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
1942{
1943  ideal_list p,h;
1944  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
1945  p=h;
1946  int l=0;
1947  while (p!=NULL) { p=p->next;l++; }
1948  lists L=(lists)omAllocBin(slists_bin);
1949  L->Init(l);
1950  l=0;
1951  while(h!=NULL)
1952  {
1953    L->m[l].data=(char *)h->d;
1954    L->m[l].rtyp=IDEAL_CMD;
1955    p=h->next;
1956    omFreeSize(h,sizeof(*h));
1957    h=p;
1958    l++;
1959  }
1960  res->data=(void *)L;
1961  return FALSE;
1962}
1963#endif /* HAVE_FACTORY */
1964static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
1965{
1966  if (rField_is_Q())
1967  {
1968    number uu=(number)u->Data();
1969    number vv=(number)v->Data();
1970    res->data=(char *)nlFarey(uu,vv);
1971    return FALSE;
1972  }
1973  else return TRUE;
1974}
1975static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
1976{
1977  if (rField_is_Q())
1978  {
1979    ideal uu=(ideal)u->Data();
1980    number vv=(number)v->Data();
1981    res->data=(void*)idFarey(uu,vv);
1982    res->rtyp=u->Typ();
1983    return FALSE;
1984  }
1985  else return TRUE;
1986}
1987static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
1988{
1989  ring r=(ring)u->Data();
1990  idhdl w;
1991  int op=iiOp;
1992  nMapFunc nMap;
1993
1994  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
1995  {
1996    int *perm=NULL;
1997    int *par_perm=NULL;
1998    int par_perm_size=0;
1999    BOOLEAN bo;
2000    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2001    if ((nMap=nSetMap(r))==NULL)
2002    {
2003      if (rEqual(r,currRing))
2004      {
2005        nMap=nCopy;
2006      }
2007      else
2008      // Allow imap/fetch to be make an exception only for:
2009      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2010            (rField_is_Q() || rField_is_Q_a() ||
2011             (rField_is_Zp() || rField_is_Zp_a())))
2012           ||
2013           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2014            (rField_is_Zp(currRing, rInternalChar(r)) ||
2015             rField_is_Zp_a(currRing, rInternalChar(r)))) )
2016      {
2017        par_perm_size=rPar(r);
2018        BITSET save_test=test;
2019        naSetChar(rInternalChar(r),r);
2020        nSetChar(currRing);
2021        test=save_test;
2022      }
2023      else
2024      {
2025        goto err_fetch;
2026      }
2027    }
2028    if ((iiOp!=FETCH_CMD) || (r->N!=pVariables) || (rPar(r)!=rPar(currRing)))
2029    {
2030      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2031      if (par_perm_size!=0)
2032        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2033      op=IMAP_CMD;
2034      if (iiOp==IMAP_CMD)
2035      {
2036        maFindPerm(r->names,       r->N,       r->parameter,        r->P,
2037                   currRing->names,currRing->N,currRing->parameter, currRing->P,
2038                   perm,par_perm, currRing->ch);
2039      }
2040      else
2041      {
2042        int i;
2043        if (par_perm_size!=0)
2044          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2045        for(i=si_min(r->N,pVariables);i>0;i--) perm[i]=i;
2046      }
2047    }
2048    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2049    {
2050      int i;
2051      for(i=0;i<si_min(r->N,pVariables);i++)
2052      {
2053        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2054      }
2055      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2056      {
2057        Print("// par nr %d: %s -> %s\n",
2058              i,r->parameter[i],currRing->parameter[i]);
2059      }
2060    }
2061    sleftv tmpW;
2062    memset(&tmpW,0,sizeof(sleftv));
2063    tmpW.rtyp=IDTYP(w);
2064    tmpW.data=IDDATA(w);
2065    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2066                         perm,par_perm,par_perm_size,nMap)))
2067    {
2068      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2069    }
2070    if (perm!=NULL)
2071      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2072    if (par_perm!=NULL)
2073      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2074    return bo;
2075  }
2076  else
2077  {
2078    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2079  }
2080  return TRUE;
2081err_fetch:
2082  Werror("no identity map from %s",u->Fullname());
2083  return TRUE;
2084}
2085static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2086{
2087  /*4
2088  * look for the substring what in the string where
2089  * return the position of the first char of what in where
2090  * or 0
2091  */
2092  char *where=(char *)u->Data();
2093  char *what=(char *)v->Data();
2094  char *found = strstr(where,what);
2095  if (found != NULL)
2096  {
2097    res->data=(char *)((found-where)+1);
2098  }
2099  /*else res->data=NULL;*/
2100  return FALSE;
2101}
2102static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2103{
2104  res->data=(char *)fractalWalkProc(u,v);
2105  setFlag( res, FLAG_STD );
2106  return FALSE;
2107}
2108static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2109{
2110  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2111  int p0=ABS(uu),p1=ABS(vv);
2112  int r;
2113  while ( p1!=0 )
2114  {
2115    r=p0 % p1;
2116    p0 = p1; p1 = r;
2117  }
2118  res->rtyp=INT_CMD;
2119  res->data=(char *)(long)p0;
2120  return FALSE;
2121}
2122static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2123{
2124  number a=(number) u->Data();
2125  number b=(number) v->Data();
2126  if (nlIsZero(a))
2127  {
2128    if (nlIsZero(b)) res->data=(char *)nlInit(1, NULL);
2129    else             res->data=(char *)nlCopy(b);
2130  }
2131  else
2132  {
2133    if (nlIsZero(b))  res->data=(char *)nlCopy(a);
2134    else res->data=(char *)nlGcd(a, b, NULL);
2135  }
2136  return FALSE;
2137}
2138static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2139{
2140  number a=(number) u->Data();
2141  number b=(number) v->Data();
2142  if (nIsZero(a))
2143  {
2144    if (nIsZero(b)) res->data=(char *)nInit(1);
2145    else            res->data=(char *)nCopy(b);
2146  }
2147  else
2148  {
2149    if (nIsZero(b))  res->data=(char *)nCopy(a);
2150    else res->data=(char *)nGcd(a, b, currRing);
2151  }
2152  return FALSE;
2153}
2154#ifdef HAVE_FACTORY
2155static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2156{
2157  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2158                                 (poly)(v->CopyD(POLY_CMD)));
2159  return FALSE;
2160}
2161#endif /* HAVE_FACTORY */
2162static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2163{
2164  assumeStdFlag(u);
2165  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2166  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2167  switch((int)(long)v->Data())
2168  {
2169    case 1:
2170      res->data=(void *)iv;
2171      return FALSE;
2172    case 2:
2173      res->data=(void *)hSecondSeries(iv);
2174      delete iv;
2175      return FALSE;
2176  }
2177  WerrorS(feNotImplemented);
2178  delete iv;
2179  return TRUE;
2180}
2181static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2182{
2183  int i=pVar((poly)v->Data());
2184  if (i==0)
2185  {
2186    WerrorS("ringvar expected");
2187    return TRUE;
2188  }
2189  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2190  int d=pWTotaldegree(p);
2191  pLmDelete(p);
2192  if (d==1)
2193    res->data = (char *)pHomogen((poly)u->Data(),i);
2194  else
2195    WerrorS("variable must have weight 1");
2196  return (d!=1);
2197}
2198static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2199{
2200  int i=pVar((poly)v->Data());
2201  if (i==0)
2202  {
2203    WerrorS("ringvar expected");
2204    return TRUE;
2205  }
2206  pFDegProc deg;
2207  if (pLexOrder && (currRing->order[0]==ringorder_lp))
2208    deg=p_Totaldegree;
2209   else
2210    deg=pFDeg;
2211  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2212  int d=deg(p,currRing);
2213  pLmDelete(p);
2214  if (d==1)
2215    res->data = (char *)idHomogen((ideal)u->Data(),i);
2216  else
2217    WerrorS("variable must have weight 1");
2218  return (d!=1);
2219}
2220static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2221{
2222  intvec *w=new intvec(rVar(currRing));
2223  intvec *vw=(intvec*)u->Data();
2224  ideal v_id=(ideal)v->Data();
2225  pFDegProc save_FDeg=pFDeg;
2226  pLDegProc save_LDeg=pLDeg;
2227  BOOLEAN save_pLexOrder=pLexOrder;
2228  pLexOrder=FALSE;
2229  kHomW=vw;
2230  kModW=w;
2231  pSetDegProcs(kHomModDeg);
2232  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2233  pLexOrder=save_pLexOrder;
2234  kHomW=NULL;
2235  kModW=NULL;
2236  pRestoreDegProcs(save_FDeg,save_LDeg);
2237  if (w!=NULL) delete w;
2238  return FALSE;
2239}
2240static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2241{
2242  assumeStdFlag(u);
2243  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2244                    currQuotient);
2245  return FALSE;
2246}
2247static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2248{
2249  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2250  setFlag(res,FLAG_STD);
2251  return FALSE;
2252}
2253static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2254{
2255  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2256}
2257static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2258{
2259  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2260  return FALSE;
2261}
2262static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2263{
2264  res->data = (char *)idJet((ideal)u->Data(),(int)(long)v->Data());
2265  return FALSE;
2266}
2267static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2268{
2269  assumeStdFlag(u);
2270  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2271  res->data = (char *)scKBase((int)(long)v->Data(),
2272                              (ideal)(u->Data()),currQuotient, w_u);
2273  if (w_u!=NULL)
2274  {
2275    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2276  }
2277  return FALSE;
2278}
2279static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2280static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2281{
2282  return jjPREIMAGE(res,u,v,NULL);
2283}
2284static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2285{
2286  return mpKoszul(res, u,v);
2287}
2288static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2289{
2290  sleftv h;
2291  memset(&h,0,sizeof(sleftv));
2292  h.rtyp=INT_CMD;
2293  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2294  return mpKoszul(res, u, &h, v);
2295}
2296static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2297{
2298  ideal m;
2299  BITSET save_test=test;
2300  int ul= IDELEMS((ideal)u->Data());
2301  int vl= IDELEMS((ideal)v->Data());
2302  m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD));
2303  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
2304  test=save_test;
2305  return FALSE;
2306}
2307static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2308{
2309  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2310  idhdl h=(idhdl)v->data;
2311  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2312  res->data = (char *)idLiftStd((ideal)u->Data(),
2313                                &(h->data.umatrix),testHomog);
2314  setFlag(res,FLAG_STD); v->flag=0;
2315  return FALSE;
2316}
2317static BOOLEAN jjLOAD2(leftv res, leftv u,leftv v)
2318{
2319  return jjLOAD(res, v,TRUE);
2320}
2321static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2322{
2323  char * s=(char *)u->Data();
2324  if(strcmp(s, "with")==0)
2325    return jjLOAD(res, v, TRUE);
2326  WerrorS("invalid second argument");
2327  WerrorS("load(\"libname\" [,\"with\"]);");
2328  return TRUE;
2329}
2330static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2331{
2332  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2333  tHomog hom=testHomog;
2334  if (w_u!=NULL)
2335  {
2336    w_u=ivCopy(w_u);
2337    hom=isHomog;
2338  }
2339  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2340  if (w_v!=NULL)
2341  {
2342    w_v=ivCopy(w_v);
2343    hom=isHomog;
2344  }
2345  if ((w_u!=NULL) && (w_v==NULL))
2346    w_v=ivCopy(w_u);
2347  if ((w_v!=NULL) && (w_u==NULL))
2348    w_u=ivCopy(w_v);
2349  ideal u_id=(ideal)u->Data();
2350  ideal v_id=(ideal)v->Data();
2351  if (w_u!=NULL)
2352  {
2353     if ((*w_u).compare((w_v))!=0)
2354     {
2355       WarnS("incompatible weights");
2356       delete w_u; w_u=NULL;
2357       hom=testHomog;
2358     }
2359     else
2360     {
2361       if ((!idTestHomModule(u_id,currQuotient,w_v))
2362       || (!idTestHomModule(v_id,currQuotient,w_v)))
2363       {
2364         WarnS("wrong weights");
2365         delete w_u; w_u=NULL;
2366         hom=testHomog;
2367       }
2368     }
2369  }
2370  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2371  if (w_u!=NULL)
2372  {
2373    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2374  }
2375  delete w_v;
2376  return FALSE;
2377}
2378static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2379{
2380  number q=(number)v->Data();
2381  if (nlIsZero(q))
2382  {
2383    WerrorS(ii_div_by_0);
2384    return TRUE;
2385  }
2386  res->data =(char *) nlIntMod((number)u->Data(),q);
2387  return FALSE;
2388}
2389static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2390{
2391  number q=(number)v->Data();
2392  if (nIsZero(q))
2393  {
2394    WerrorS(ii_div_by_0);
2395    return TRUE;
2396  }
2397  res->data =(char *) nIntMod((number)u->Data(),q);
2398  return FALSE;
2399}
2400static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2401static BOOLEAN jjMONITOR1(leftv res, leftv v)
2402{
2403  return jjMONITOR2(res,v,NULL);
2404}
2405static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v)
2406{
2407#if 0
2408  char *opt=(char *)v->Data();
2409  int mode=0;
2410  while(*opt!='\0')
2411  {
2412    if (*opt=='i') mode |= PROT_I;
2413    else if (*opt=='o') mode |= PROT_O;
2414    opt++;
2415  }
2416  monitor((char *)(u->Data()),mode);
2417#else
2418  si_link l=(si_link)u->Data();
2419  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2420  if(strcmp(l->m->type,"ASCII")!=0)
2421  {
2422    Werror("ASCII link required, not `%s`",l->m->type);
2423    slClose(l);
2424    return TRUE;
2425  }
2426  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2427  if ( l->name[0]!='\0') // "" is the stop condition
2428  {
2429    const char *opt;
2430    int mode=0;
2431    if (v==NULL) opt=(const char*)"i";
2432    else         opt=(const char *)v->Data();
2433    while(*opt!='\0')
2434    {
2435      if (*opt=='i') mode |= PROT_I;
2436      else if (*opt=='o') mode |= PROT_O;
2437      opt++;
2438    }
2439    monitor((FILE *)l->data,mode);
2440  }
2441  else
2442    monitor(NULL,0);
2443  return FALSE;
2444#endif
2445}
2446static BOOLEAN jjMONOM(leftv res, leftv v)
2447{
2448  intvec *iv=(intvec *)v->Data();
2449  poly p=pOne();
2450  int i,e;
2451  BOOLEAN err=FALSE;
2452  for(i=si_min(pVariables,iv->length()); i>0; i--)
2453  {
2454    e=(*iv)[i-1];
2455    if (e>=0) pSetExp(p,i,e);
2456    else err=TRUE;
2457  }
2458  if (iv->length()==(pVariables+1))
2459  {
2460    res->rtyp=VECTOR_CMD;
2461    e=(*iv)[pVariables];
2462    if (e>=0) pSetComp(p,e);
2463    else err=TRUE;
2464  }
2465  pSetm(p);
2466  res->data=(char*)p;
2467  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2468  return err;
2469}
2470static BOOLEAN jjNEWSTRUCT2(leftv res, leftv u, leftv v)
2471{
2472  // u: the name of the new type
2473  // v: the elements
2474  newstruct_desc d=newstructFromString((const char *)v->Data());
2475  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2476  return d==NULL;
2477}
2478static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2479{
2480  idhdl h=(idhdl)u->data;
2481  int i=(int)(long)v->Data();
2482  int p=0;
2483  if ((0<i)
2484  && (IDRING(h)->parameter!=NULL)
2485  && (i<=(p=rPar(IDRING(h)))))
2486    res->data=omStrDup(IDRING(h)->parameter[i-1]);
2487  else
2488  {
2489    Werror("par number %d out of range 1..%d",i,p);
2490    return TRUE;
2491  }
2492  return FALSE;
2493}
2494#ifdef HAVE_PLURAL
2495static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2496{
2497  if( currRing->qideal != NULL )
2498  {
2499    WerrorS("basering must NOT be a qring!");
2500    return TRUE;
2501  }
2502
2503  if (iiOp==NCALGEBRA_CMD)
2504  {
2505    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing);
2506  }
2507  else
2508  {
2509    ring r=rCopy(currRing);
2510    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r);
2511    res->data=r;
2512    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2513    return result;
2514  }
2515}
2516static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2517{
2518  if( currRing->qideal != NULL )
2519  {
2520    WerrorS("basering must NOT be a qring!");
2521    return TRUE;
2522  }
2523
2524  if (iiOp==NCALGEBRA_CMD)
2525  {
2526    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing);
2527  }
2528  else
2529  {
2530    ring r=rCopy(currRing);
2531    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r);
2532    res->data=r;
2533    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2534    return result;
2535  }
2536}
2537static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2538{
2539  if( currRing->qideal != NULL )
2540  {
2541    WerrorS("basering must NOT be a qring!");
2542    return TRUE;
2543  }
2544
2545  if (iiOp==NCALGEBRA_CMD)
2546  {
2547    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing);
2548  }
2549  else
2550  {
2551    ring r=rCopy(currRing);
2552    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r);
2553    res->data=r;
2554    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2555    return result;
2556  }
2557}
2558static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2559{
2560  if( currRing->qideal != NULL )
2561  {
2562    WerrorS("basering must NOT be a qring!");
2563    return TRUE;
2564  }
2565
2566  if (iiOp==NCALGEBRA_CMD)
2567  {
2568    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing);
2569  }
2570  else
2571  {
2572    ring r=rCopy(currRing);
2573    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r);
2574    res->data=r;
2575    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2576    return result;
2577  }
2578}
2579static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2580{
2581  res->data=NULL;
2582
2583  if (rIsPluralRing(currRing))
2584  {
2585    const poly q = (poly)b->Data();
2586
2587    if( q != NULL )
2588    {
2589      if( (poly)a->Data() != NULL )
2590      {
2591        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2592        res->data = nc_p_Bracket_qq(p,q); // p will be destroyed!
2593      }
2594    }
2595  }
2596  return FALSE;
2597}
2598static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2599{
2600  /* number, poly, vector, ideal, module, matrix */
2601  ring  r = (ring)a->Data();
2602  if (r == currRing)
2603  {
2604    res->data = b->Data();
2605    res->rtyp = b->rtyp;
2606    return FALSE;
2607  }
2608  if (!rIsLikeOpposite(currRing, r))
2609  {
2610    Werror("%s is not an opposite ring to current ring",a->Fullname());
2611    return TRUE;
2612  }
2613  idhdl w;
2614  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2615  {
2616    int argtype = IDTYP(w);
2617    switch (argtype)
2618    {
2619    case NUMBER_CMD:
2620      {
2621        /* since basefields are equal, we can apply nCopy */
2622        res->data = nCopy((number)IDDATA(w));
2623        res->rtyp = argtype;
2624        break;
2625      }
2626    case POLY_CMD:
2627    case VECTOR_CMD:
2628      {
2629        poly    q = (poly)IDDATA(w);
2630        res->data = pOppose(r,q);
2631        res->rtyp = argtype;
2632        break;
2633      }
2634    case IDEAL_CMD:
2635    case MODUL_CMD:
2636      {
2637        ideal   Q = (ideal)IDDATA(w);
2638        res->data = idOppose(r,Q);
2639        res->rtyp = argtype;
2640        break;
2641      }
2642    case MATRIX_CMD:
2643      {
2644        ring save = currRing;
2645        rChangeCurrRing(r);
2646        matrix  m = (matrix)IDDATA(w);
2647        ideal   Q = idMatrix2Module(mpCopy(m));
2648        rChangeCurrRing(save);
2649        ideal   S = idOppose(r,Q);
2650        id_Delete(&Q, r);
2651        res->data = idModule2Matrix(S);
2652        res->rtyp = argtype;
2653        break;
2654      }
2655    default:
2656      {
2657        WerrorS("unsupported type in oppose");
2658        return TRUE;
2659      }
2660    }
2661  }
2662  else
2663  {
2664    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2665    return TRUE;
2666  }
2667  return FALSE;
2668}
2669#endif /* HAVE_PLURAL */
2670
2671static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2672{
2673  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2674    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2675  idDelMultiples((ideal)(res->data));
2676  return FALSE;
2677}
2678static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2679{
2680  int i=(int)(long)u->Data();
2681  int j=(int)(long)v->Data();
2682  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2683  return FALSE;
2684}
2685static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2686{
2687  matrix m =(matrix)u->Data();
2688  int isRowEchelon = (int)(long)v->Data();
2689  if (isRowEchelon != 1) isRowEchelon = 0;
2690  int rank = luRank(m, isRowEchelon);
2691  res->data =(char *)(long)rank;
2692  return FALSE;
2693}
2694static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2695{
2696  si_link l=(si_link)u->Data();
2697  leftv r=slRead(l,v);
2698  if (r==NULL)
2699  {
2700    const char *s;
2701    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2702    else                            s=sNoName;
2703    Werror("cannot read from `%s`",s);
2704    return TRUE;
2705  }
2706  memcpy(res,r,sizeof(sleftv));
2707  omFreeBin((ADDRESS)r, sleftv_bin);
2708  return FALSE;
2709}
2710static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2711{
2712  assumeStdFlag(v);
2713  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2714  return FALSE;
2715}
2716static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2717{
2718  assumeStdFlag(v);
2719  ideal ui=(ideal)u->Data();
2720  idTest(ui);
2721  ideal vi=(ideal)v->Data();
2722  idTest(vi);
2723  res->data = (char *)kNF(vi,currQuotient,ui);
2724  return FALSE;
2725}
2726#if 0
2727static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2728{
2729  int maxl=(int)(long)v->Data();
2730  if (maxl<0)
2731  {
2732    WerrorS("length for res must not be negative");
2733    return TRUE;
2734  }
2735  int l=0;
2736  //resolvente r;
2737  syStrategy r;
2738  intvec *weights=NULL;
2739  int wmaxl=maxl;
2740  ideal u_id=(ideal)u->Data();
2741
2742  maxl--;
2743  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2744  {
2745    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2746    if (currQuotient!=NULL)
2747    {
2748      Warn(
2749      "full resolution in a qring may be infinite, setting max length to %d",
2750      maxl+1);
2751    }
2752  }
2753  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2754  if (weights!=NULL)
2755  {
2756    if (!idTestHomModule(u_id,currQuotient,weights))
2757    {
2758      WarnS("wrong weights given:");weights->show();PrintLn();
2759      weights=NULL;
2760    }
2761  }
2762  intvec *ww=NULL;
2763  int add_row_shift=0;
2764  if (weights!=NULL)
2765  {
2766     ww=ivCopy(weights);
2767     add_row_shift = ww->min_in();
2768     (*ww) -= add_row_shift;
2769  }
2770  else
2771    idHomModule(u_id,currQuotient,&ww);
2772  weights=ww;
2773
2774  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2775  {
2776    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2777  }
2778  else if (iiOp==SRES_CMD)
2779  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2780    r=sySchreyer(u_id,maxl+1);
2781  else if (iiOp == LRES_CMD)
2782  {
2783    int dummy;
2784    if((currQuotient!=NULL)||
2785    (!idHomIdeal (u_id,NULL)))
2786    {
2787       WerrorS
2788       ("`lres` not implemented for inhomogeneous input or qring");
2789       return TRUE;
2790    }
2791    r=syLaScala3(u_id,&dummy);
2792  }
2793  else if (iiOp == KRES_CMD)
2794  {
2795    int dummy;
2796    if((currQuotient!=NULL)||
2797    (!idHomIdeal (u_id,NULL)))
2798    {
2799       WerrorS
2800       ("`kres` not implemented for inhomogeneous input or qring");
2801       return TRUE;
2802    }
2803    r=syKosz(u_id,&dummy);
2804  }
2805  else
2806  {
2807    int dummy;
2808    if((currQuotient!=NULL)||
2809    (!idHomIdeal (u_id,NULL)))
2810    {
2811       WerrorS
2812       ("`hres` not implemented for inhomogeneous input or qring");
2813       return TRUE;
2814    }
2815    r=syHilb(u_id,&dummy);
2816  }
2817  if (r==NULL) return TRUE;
2818  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2819  r->list_length=wmaxl;
2820  res->data=(void *)r;
2821  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2822  {
2823    intvec *w=ivCopy(r->weights[0]);
2824    if (weights!=NULL) (*w) += add_row_shift;
2825    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
2826    w=NULL;
2827  }
2828  else
2829  {
2830//#if 0
2831// need to set weights for ALL components (sres)
2832    if (weights!=NULL)
2833    {
2834      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2835      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
2836      (r->weights)[0] = ivCopy(weights);
2837    }
2838//#endif
2839  }
2840  if (ww!=NULL) { delete ww; ww=NULL; }
2841  return FALSE;
2842}
2843#else
2844static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2845{
2846  int maxl=(int)(long)v->Data();
2847  if (maxl<0)
2848  {
2849    WerrorS("length for res must not be negative");
2850    return TRUE;
2851  }
2852  int l=0;
2853  //resolvente r;
2854  syStrategy r;
2855  intvec *weights=NULL;
2856  int wmaxl=maxl;
2857  ideal u_id=(ideal)u->Data();
2858
2859  maxl--;
2860  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2861  {
2862    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2863    if (currQuotient!=NULL)
2864    {
2865      Warn(
2866      "full resolution in a qring may be infinite, setting max length to %d",
2867      maxl+1);
2868    }
2869  }
2870  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2871  if (weights!=NULL)
2872  {
2873    if (!idTestHomModule(u_id,currQuotient,weights))
2874    {
2875      WarnS("wrong weights given:");weights->show();PrintLn();
2876      weights=NULL;
2877    }
2878  }
2879  intvec *ww=NULL;
2880  int add_row_shift=0;
2881  if (weights!=NULL)
2882  {
2883     ww=ivCopy(weights);
2884     add_row_shift = ww->min_in();
2885     (*ww) -= add_row_shift;
2886  }
2887  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2888  {
2889    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2890  }
2891  else if (iiOp==SRES_CMD)
2892  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2893    r=sySchreyer(u_id,maxl+1);
2894  else if (iiOp == LRES_CMD)
2895  {
2896    int dummy;
2897    if((currQuotient!=NULL)||
2898    (!idHomIdeal (u_id,NULL)))
2899    {
2900       WerrorS
2901       ("`lres` not implemented for inhomogeneous input or qring");
2902       return TRUE;
2903    }
2904    r=syLaScala3(u_id,&dummy);
2905  }
2906  else if (iiOp == KRES_CMD)
2907  {
2908    int dummy;
2909    if((currQuotient!=NULL)||
2910    (!idHomIdeal (u_id,NULL)))
2911    {
2912       WerrorS
2913       ("`kres` not implemented for inhomogeneous input or qring");
2914       return TRUE;
2915    }
2916    r=syKosz(u_id,&dummy);
2917  }
2918  else
2919  {
2920    int dummy;
2921    if((currQuotient!=NULL)||
2922    (!idHomIdeal (u_id,NULL)))
2923    {
2924       WerrorS
2925       ("`hres` not implemented for inhomogeneous input or qring");
2926       return TRUE;
2927    }
2928    ideal u_id_copy=idCopy(u_id);
2929    idSkipZeroes(u_id_copy);
2930    r=syHilb(u_id_copy,&dummy);
2931    idDelete(&u_id_copy);
2932  }
2933  if (r==NULL) return TRUE;
2934  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2935  r->list_length=wmaxl;
2936  res->data=(void *)r;
2937  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
2938  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2939  {
2940    ww=ivCopy(r->weights[0]);
2941    if (weights!=NULL) (*ww) += add_row_shift;
2942    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
2943  }
2944  else
2945  {
2946    if (weights!=NULL)
2947    {
2948      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2949    }
2950  }
2951  return FALSE;
2952}
2953#endif
2954static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
2955{
2956  number n1; number n2; number temp; int i;
2957
2958  if ((u->Typ() == BIGINT_CMD) ||
2959     ((u->Typ() == NUMBER_CMD) && rField_is_Q()))
2960  {
2961    temp = (number)u->Data();
2962    n1 = nlCopy(temp);
2963  }
2964  else if (u->Typ() == INT_CMD)
2965  {
2966    i = (int)(long)u->Data();
2967    n1 = nlInit(i, NULL);
2968  }
2969  else
2970  {
2971    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
2972    return TRUE;
2973  }
2974
2975  if ((v->Typ() == BIGINT_CMD) ||
2976     ((v->Typ() == NUMBER_CMD) && rField_is_Q()))
2977  {
2978    temp = (number)v->Data();
2979    n2 = nlCopy(temp);
2980  }
2981  else if (v->Typ() == INT_CMD)
2982  {
2983    i = (int)(long)v->Data();
2984    n2 = nlInit(i, NULL);
2985  }
2986  else
2987  {
2988    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
2989    return TRUE;
2990  }
2991
2992  lists l = primeFactorisation(n1, n2);
2993  nlDelete(&n1, NULL); nlDelete(&n2, NULL);
2994  res->data = (char*)l;
2995  return FALSE;
2996}
2997static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
2998{
2999  ring r;
3000  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3001  res->data = (char *)r;
3002  return (i==-1);
3003}
3004#define SIMPL_LMDIV 32
3005#define SIMPL_LMEQ  16
3006#define SIMPL_MULT 8
3007#define SIMPL_EQU  4
3008#define SIMPL_NULL 2
3009#define SIMPL_NORM 1
3010static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3011{
3012  int sw = (int)(long)v->Data();
3013  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3014  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3015  if (sw & SIMPL_LMDIV)
3016  {
3017    idDelDiv(id);
3018  }
3019  if (sw & SIMPL_LMEQ)
3020  {
3021    idDelLmEquals(id);
3022  }
3023  if (sw & SIMPL_MULT)
3024  {
3025    idDelMultiples(id);
3026  }
3027  else if(sw & SIMPL_EQU)
3028  {
3029    idDelEquals(id);
3030  }
3031  if (sw & SIMPL_NULL)
3032  {
3033    idSkipZeroes(id);
3034  }
3035  if (sw & SIMPL_NORM)
3036  {
3037    idNorm(id);
3038  }
3039  res->data = (char * )id;
3040  return FALSE;
3041}
3042static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3043{
3044  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3045  return FALSE;
3046}
3047static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3048{
3049  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3050  //return (res->data== (void*)(long)-2);
3051  return FALSE;
3052}
3053static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3054{
3055  int sw = (int)(long)v->Data();
3056  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3057  poly p = (poly)u->CopyD(POLY_CMD);
3058  if (sw & SIMPL_NORM)
3059  {
3060    pNorm(p);
3061  }
3062  res->data = (char * )p;
3063  return FALSE;
3064}
3065static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3066{
3067  ideal result;
3068  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3069  tHomog hom=testHomog;
3070  ideal u_id=(ideal)(u->Data());
3071  if (w!=NULL)
3072  {
3073    if (!idTestHomModule(u_id,currQuotient,w))
3074    {
3075      WarnS("wrong weights:");w->show();PrintLn();
3076      w=NULL;
3077    }
3078    else
3079    {
3080      w=ivCopy(w);
3081      hom=isHomog;
3082    }
3083  }
3084  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3085  idSkipZeroes(result);
3086  res->data = (char *)result;
3087  setFlag(res,FLAG_STD);
3088  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3089  return FALSE;
3090}
3091static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3092static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3093/* destroys i0, p0 */
3094/* result (with attributes) in res */
3095/* i0: SB*/
3096/* t0: type of p0*/
3097/* p0 new elements*/
3098/* a attributes of i0*/
3099{
3100  int tp;
3101  if (t0==IDEAL_CMD) tp=POLY_CMD;
3102  else               tp=VECTOR_CMD;
3103  for (int i=IDELEMS(p0)-1; i>=0; i--)
3104  {
3105    poly p=p0->m[i];
3106    p0->m[i]=NULL;
3107    if (p!=NULL)
3108    {
3109      sleftv u0,v0;
3110      memset(&u0,0,sizeof(sleftv));
3111      memset(&v0,0,sizeof(sleftv));
3112      v0.rtyp=tp;
3113      v0.data=(void*)p;
3114      u0.rtyp=t0;
3115      u0.data=i0;
3116      u0.attribute=a;
3117      setFlag(&u0,FLAG_STD);
3118      jjSTD_1(res,&u0,&v0);
3119      i0=(ideal)res->data;
3120      res->data=NULL;
3121      a=res->attribute;
3122      res->attribute=NULL;
3123      u0.CleanUp();
3124      v0.CleanUp();
3125      res->CleanUp();
3126    }
3127  }
3128  idDelete(&p0);
3129  res->attribute=a;
3130  res->data=(void *)i0;
3131  res->rtyp=t0;
3132}
3133static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3134{
3135  ideal result;
3136  assumeStdFlag(u);
3137  ideal i1=(ideal)(u->Data());
3138  ideal i0;
3139  int r=v->Typ();
3140  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3141  {
3142    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3143    i0->m[0]=(poly)v->Data();
3144    int ii0=idElem(i0); /* size of i0 */
3145    i1=idSimpleAdd(i1,i0); //
3146    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3147    idDelete(&i0);
3148    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3149    tHomog hom=testHomog;
3150
3151    if (w!=NULL)
3152    {
3153      if (!idTestHomModule(i1,currQuotient,w))
3154      {
3155        // no warnung: this is legal, if i in std(i,p)
3156        // is homogeneous, but p not
3157        w=NULL;
3158      }
3159      else
3160      {
3161        w=ivCopy(w);
3162        hom=isHomog;
3163      }
3164    }
3165    BITSET save_test=test;
3166    test|=Sy_bit(OPT_SB_1);
3167    /* ii0 appears to be the position of the first element of il that
3168       does not belong to the old SB ideal */
3169    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3170    test=save_test;
3171    idDelete(&i1);
3172    idSkipZeroes(result);
3173    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3174    res->data = (char *)result;
3175  }
3176  else /*IDEAL/MODULE*/
3177  {
3178    attr a=NULL;
3179    if (u->attribute!=NULL) a=u->attribute->Copy();
3180    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3181  }
3182  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3183  return FALSE;
3184}
3185static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3186{
3187  idhdl h=(idhdl)u->data;
3188  int i=(int)(long)v->Data();
3189  if ((0<i) && (i<=IDRING(h)->N))
3190    res->data=omStrDup(IDRING(h)->names[i-1]);
3191  else
3192  {
3193    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3194    return TRUE;
3195  }
3196  return FALSE;
3197}
3198static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3199{
3200  lists Lforks = (lists)u->Data();
3201  int t = (int)(long)v->Data();
3202  int i = slStatusSsiL(Lforks, t*1000);
3203  if ( i < 0 ) i = 0;
3204  res->data = (void*)(long)i;
3205  return FALSE;
3206}
3207static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3208{
3209/* returns 1 iff all forks are finished; 0 otherwise */
3210  lists Lforks = (lists)u->Data();
3211  int timeout = 1000*(int)(long)v->Data();
3212  lists oneFork=(lists)omAllocBin(slists_bin);
3213  oneFork->Init(1);
3214  int i;
3215  int t = getTimer();
3216  int ret = 1;
3217  for (int j = 0; j <= Lforks->nr; j++)
3218  {
3219    oneFork->m[0].Copy(&Lforks->m[j]);
3220    i = slStatusSsiL(oneFork, timeout);
3221    if (i == 1)
3222    {
3223      timeout = timeout - getTimer() + t;
3224    }
3225    else { ret = 0; j = Lforks->nr+1; /* terminate the for loop */ }
3226    omFreeSize((ADDRESS)oneFork->m,sizeof(sleftv));
3227  }
3228  omFreeBin((ADDRESS)oneFork, slists_bin);
3229  res->data = (void*)(long)ret;
3230  return FALSE;
3231}
3232static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3233{
3234  res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
3235  return FALSE;
3236}
3237#define jjWRONG2 (proc2)jjWRONG
3238#define jjWRONG3 (proc3)jjWRONG
3239static BOOLEAN jjWRONG(leftv res, leftv u)
3240{
3241  return TRUE;
3242}
3243
3244/*=================== operations with 1 arg.: static proc =================*/
3245/* must be ordered: first operations for chars (infix ops),
3246 * then alphabetically */
3247
3248static BOOLEAN jjDUMMY(leftv res, leftv u)
3249{
3250  res->data = (char *)u->CopyD();
3251  return FALSE;
3252}
3253static BOOLEAN jjNULL(leftv res, leftv u)
3254{
3255  return FALSE;
3256}
3257//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3258//{
3259//  res->data = (char *)((int)(long)u->Data()+1);
3260//  return FALSE;
3261//}
3262//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3263//{
3264//  res->data = (char *)((int)(long)u->Data()-1);
3265//  return FALSE;
3266//}
3267static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3268{
3269  if (IDTYP((idhdl)u->data)==INT_CMD)
3270  {
3271    int i=IDINT((idhdl)u->data);
3272    if (iiOp==PLUSPLUS) i++;
3273    else                i--;
3274    IDDATA((idhdl)u->data)=(char *)(long)i;
3275    return FALSE;
3276  }
3277  return TRUE;
3278}
3279static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3280{
3281  number n=(number)u->CopyD(BIGINT_CMD);
3282  n=nlNeg(n);
3283  res->data = (char *)n;
3284  return FALSE;
3285}
3286static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3287{
3288  res->data = (char *)(-(long)u->Data());
3289  return FALSE;
3290}
3291static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3292{
3293  number n=(number)u->CopyD(NUMBER_CMD);
3294  n=nNeg(n);
3295  res->data = (char *)n;
3296  return FALSE;
3297}
3298static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3299{
3300  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3301  return FALSE;
3302}
3303static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3304{
3305  poly m1=pISet(-1);
3306  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
3307  return FALSE;
3308}
3309static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3310{
3311  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3312  (*iv)*=(-1);
3313  res->data = (char *)iv;
3314  return FALSE;
3315}
3316static BOOLEAN jjPROC1(leftv res, leftv u)
3317{
3318  return jjPROC(res,u,NULL);
3319}
3320static BOOLEAN jjBAREISS(leftv res, leftv v)
3321{
3322  //matrix m=(matrix)v->Data();
3323  //lists l=mpBareiss(m,FALSE);
3324  intvec *iv;
3325  ideal m;
3326  smCallBareiss((ideal)v->Data(),0,0,m,&iv);
3327  lists l=(lists)omAllocBin(slists_bin);
3328  l->Init(2);
3329  l->m[0].rtyp=MODUL_CMD;
3330  l->m[1].rtyp=INTVEC_CMD;
3331  l->m[0].data=(void *)m;
3332  l->m[1].data=(void *)iv;
3333  res->data = (char *)l;
3334  return FALSE;
3335}
3336//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3337//{
3338//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3339//  ivTriangMat(m);
3340//  res->data = (char *)m;
3341//  return FALSE;
3342//}
3343static BOOLEAN jjBI2N(leftv res, leftv u)
3344{
3345  if (rField_is_Q())
3346  {
3347    res->data=u->CopyD();
3348    return FALSE;
3349  }
3350  else
3351  {
3352    BOOLEAN bo=FALSE;
3353    number n=(number)u->CopyD();
3354    if (rField_is_Zp())
3355    {
3356      res->data=(void *)npMap0(n);
3357    }
3358    else if (rField_is_Q_a())
3359    {
3360      res->data=(void *)naMap00(n);
3361    }
3362    else if (rField_is_Zp_a())
3363    {
3364      res->data=(void *)naMap0P(n);
3365    }
3366#ifdef HAVE_RINGS
3367    else if (rField_is_Ring_Z())
3368    {
3369      res->data=(void *)nrzMapQ(n);
3370    }
3371    else if (rField_is_Ring_ModN())
3372    {
3373      res->data=(void *)nrnMapQ(n);
3374    }
3375    else if (rField_is_Ring_PtoM())
3376    {
3377      res->data=(void *)nrnMapQ(n);
3378    }
3379    else if (rField_is_Ring_2toM())
3380    {
3381      res->data=(void *)nr2mMapQ(n);
3382    }
3383#endif
3384    else
3385    {
3386      WerrorS("cannot convert bigint to this field");
3387      bo=TRUE;
3388    }
3389    nlDelete(&n,NULL);
3390    return bo;
3391  }
3392}
3393static BOOLEAN jjBI2P(leftv res, leftv u)
3394{
3395  sleftv tmp;
3396  BOOLEAN bo=jjBI2N(&tmp,u);
3397  if (!bo)
3398  {
3399    number n=(number) tmp.data;
3400    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3401    else
3402    {
3403      res->data=(void *)pNSet(n);
3404    }
3405  }
3406  return bo;
3407}
3408static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3409{
3410  return iiExprArithM(res,u,iiOp);
3411}
3412static BOOLEAN jjCHAR(leftv res, leftv v)
3413{
3414  res->data = (char *)(long)rChar((ring)v->Data());
3415  return FALSE;
3416}
3417static BOOLEAN jjCOLS(leftv res, leftv v)
3418{
3419  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3420  return FALSE;
3421}
3422static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3423{
3424  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3425  return FALSE;
3426}
3427static BOOLEAN jjCONTENT(leftv res, leftv v)
3428{
3429  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3430  poly p=(poly)v->CopyD(POLY_CMD);
3431  if (p!=NULL) p_Cleardenom(p, currRing);
3432  res->data = (char *)p;
3433  return FALSE;
3434}
3435static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3436{
3437  res->data = (char *)(long)nlSize((number)v->Data());
3438  return FALSE;
3439}
3440static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3441{
3442  res->data = (char *)(long)nSize((number)v->Data());
3443  return FALSE;
3444}
3445static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3446{
3447  lists l=(lists)v->Data();
3448  res->data = (char *)(long)(l->nr+1);
3449  return FALSE;
3450}
3451static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3452{
3453  matrix m=(matrix)v->Data();
3454  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3455  return FALSE;
3456}
3457static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3458{
3459  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3460  return FALSE;
3461}
3462static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3463{
3464  ring r=(ring)v->Data();
3465  int elems=-1;
3466  if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
3467  else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
3468  {
3469#ifdef HAVE_FACTORY
3470    extern int ipower ( int b, int n ); /* factory/cf_util */
3471    elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
3472#else
3473    elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
3474#endif
3475  }
3476  res->data = (char *)(long)elems;
3477  return FALSE;
3478}
3479static BOOLEAN jjDEG(leftv res, leftv v)
3480{
3481  int dummy;
3482  poly p=(poly)v->Data();
3483  if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
3484  else res->data=(char *)-1;
3485  return FALSE;
3486}
3487static BOOLEAN jjDEG_M(leftv res, leftv u)
3488{
3489  ideal I=(ideal)u->Data();
3490  int d=-1;
3491  int dummy;
3492  int i;
3493  for(i=IDELEMS(I)-1;i>=0;i--)
3494    if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
3495  res->data = (char *)(long)d;
3496  return FALSE;
3497}
3498static BOOLEAN jjDEGREE(leftv res, leftv v)
3499{
3500  assumeStdFlag(v);
3501  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3502  scDegree((ideal)v->Data(),module_w,currQuotient);
3503  return FALSE;
3504}
3505static BOOLEAN jjDEFINED(leftv res, leftv v)
3506{
3507  if ((v->rtyp==IDHDL)
3508  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3509  {
3510    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3511  }
3512  else if (v->rtyp!=0) res->data=(void *)(-1);
3513  return FALSE;
3514}
3515#ifdef HAVE_FACTORY
3516static BOOLEAN jjDET(leftv res, leftv v)
3517{
3518  matrix m=(matrix)v->Data();
3519  poly p;
3520  if (smCheckDet((ideal)m,m->cols(),TRUE))
3521  {
3522    ideal I=idMatrix2Module(mpCopy(m));
3523    p=smCallDet(I);
3524    idDelete(&I);
3525  }
3526  else
3527    p=singclap_det(m);
3528  res ->data = (char *)p;
3529  return FALSE;
3530}
3531static BOOLEAN jjDET_I(leftv res, leftv v)
3532{
3533  intvec * m=(intvec*)v->Data();
3534  int i,j;
3535  i=m->rows();j=m->cols();
3536  if(i==j)
3537    res->data = (char *)(long)singclap_det_i(m);
3538  else
3539  {
3540    Werror("det of %d x %d intmat",i,j);
3541    return TRUE;
3542  }
3543  return FALSE;
3544}
3545static BOOLEAN jjDET_S(leftv res, leftv v)
3546{
3547  ideal I=(ideal)v->Data();
3548  poly p;
3549  if (IDELEMS(I)<1) return TRUE;
3550  if (smCheckDet(I,IDELEMS(I),FALSE))
3551  {
3552    matrix m=idModule2Matrix(idCopy(I));
3553    p=singclap_det(m);
3554    idDelete((ideal *)&m);
3555  }
3556  else
3557    p=smCallDet(I);
3558  res->data = (char *)p;
3559  return FALSE;
3560}
3561#endif
3562static BOOLEAN jjDIM(leftv res, leftv v)
3563{
3564  assumeStdFlag(v);
3565  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3566  return FALSE;
3567}
3568static BOOLEAN jjDUMP(leftv res, leftv v)
3569{
3570  si_link l = (si_link)v->Data();
3571  if (slDump(l))
3572  {
3573    const char *s;
3574    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3575    else                            s=sNoName;
3576    Werror("cannot dump to `%s`",s);
3577    return TRUE;
3578  }
3579  else
3580    return FALSE;
3581}
3582static BOOLEAN jjE(leftv res, leftv v)
3583{
3584  res->data = (char *)pOne();
3585  int co=(int)(long)v->Data();
3586  if (co>0)
3587  {
3588    pSetComp((poly)res->data,co);
3589    pSetm((poly)res->data);
3590  }
3591  else WerrorS("argument of gen must be positive");
3592  return (co<=0);
3593}
3594static BOOLEAN jjEXECUTE(leftv res, leftv v)
3595{
3596  char * d = (char *)v->Data();
3597  char * s = (char *)omAlloc(strlen(d) + 13);
3598  strcpy( s, (char *)d);
3599  strcat( s, "\n;RETURN();\n");
3600  newBuffer(s,BT_execute);
3601  return yyparse();
3602}
3603#ifdef HAVE_FACTORY
3604static BOOLEAN jjFACSTD(leftv res, leftv v)
3605{
3606  ideal_list p,h;
3607  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3608  lists L=(lists)omAllocBin(slists_bin);
3609  if (h==NULL)
3610  {
3611    L->Init(1);
3612    L->m[0].data=(char *)idInit(0,1);
3613    L->m[0].rtyp=IDEAL_CMD;
3614  }
3615  else
3616  {
3617    p=h;
3618    int l=0;
3619    while (p!=NULL) { p=p->next;l++; }
3620    L->Init(l);
3621    l=0;
3622    while(h!=NULL)
3623    {
3624      L->m[l].data=(char *)h->d;
3625      L->m[l].rtyp=IDEAL_CMD;
3626      p=h->next;
3627      omFreeSize(h,sizeof(*h));
3628      h=p;
3629      l++;
3630    }
3631  }
3632  res->data=(void *)L;
3633  return FALSE;
3634}
3635static BOOLEAN jjFAC_P(leftv res, leftv u)
3636{
3637  intvec *v=NULL;
3638  singclap_factorize_retry=0;
3639  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
3640  if (f==NULL) return TRUE;
3641  ivTest(v);
3642  lists l=(lists)omAllocBin(slists_bin);
3643  l->Init(2);
3644  l->m[0].rtyp=IDEAL_CMD;
3645  l->m[0].data=(void *)f;
3646  l->m[1].rtyp=INTVEC_CMD;
3647  l->m[1].data=(void *)v;
3648  res->data=(void *)l;
3649  return FALSE;
3650}
3651#endif
3652static BOOLEAN jjGETDUMP(leftv res, leftv v)
3653{
3654  si_link l = (si_link)v->Data();
3655  if (slGetDump(l))
3656  {
3657    const char *s;
3658    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3659    else                            s=sNoName;
3660    Werror("cannot get dump from `%s`",s);
3661    return TRUE;
3662  }
3663  else
3664    return FALSE;
3665}
3666static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
3667{
3668  assumeStdFlag(v);
3669  ideal I=(ideal)v->Data();
3670  res->data=(void *)iiHighCorner(I,0);
3671  return FALSE;
3672}
3673static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
3674{
3675  assumeStdFlag(v);
3676  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3677  BOOLEAN delete_w=FALSE;
3678  ideal I=(ideal)v->Data();
3679  int i;
3680  poly p=NULL,po=NULL;
3681  int rk=idRankFreeModule(I);
3682  if (w==NULL)
3683  {
3684    w = new intvec(rk);
3685    delete_w=TRUE;
3686  }
3687  for(i=rk;i>0;i--)
3688  {
3689    p=iiHighCorner(I,i);
3690    if (p==NULL)
3691    {
3692      WerrorS("module must be zero-dimensional");
3693      if (delete_w) delete w;
3694      return TRUE;
3695    }
3696    if (po==NULL)
3697    {
3698      po=p;
3699    }
3700    else
3701    {
3702      // now po!=NULL, p!=NULL
3703      int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
3704      if (d==0)
3705        d=pLmCmp(po,p);
3706      if (d > 0)
3707      {
3708        pDelete(&p);
3709      }
3710      else // (d < 0)
3711      {
3712        pDelete(&po); po=p;
3713      }
3714    }
3715  }
3716  if (delete_w) delete w;
3717  res->data=(void *)po;
3718  return FALSE;
3719}
3720static BOOLEAN jjHILBERT(leftv res, leftv v)
3721{
3722  assumeStdFlag(v);
3723  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3724  //scHilbertPoly((ideal)v->Data(),currQuotient);
3725  hLookSeries((ideal)v->Data(),module_w,currQuotient);
3726  return FALSE;
3727}
3728static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
3729{
3730  res->data=(void *)hSecondSeries((intvec *)v->Data());
3731  return FALSE;
3732}
3733static BOOLEAN jjHOMOG1(leftv res, leftv v)
3734{
3735  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3736  ideal v_id=(ideal)v->Data();
3737  if (w==NULL)
3738  {
3739    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
3740    if (res->data!=NULL)
3741    {
3742      if (v->rtyp==IDHDL)
3743      {
3744        char *s_isHomog=omStrDup("isHomog");
3745        if (v->e==NULL)
3746          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
3747        else
3748          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
3749      }
3750      else if (w!=NULL) delete w;
3751    } // if res->data==NULL then w==NULL
3752  }
3753  else
3754  {
3755    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
3756    if((res->data==NULL) && (v->rtyp==IDHDL))
3757    {
3758      if (v->e==NULL)
3759        atKill((idhdl)(v->data),"isHomog");
3760      else
3761        atKill((idhdl)(v->LData()),"isHomog");
3762    }
3763  }
3764  return FALSE;
3765}
3766static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
3767{
3768  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
3769  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
3770  if (IDELEMS((ideal)mat)==0)
3771  {
3772    idDelete((ideal *)&mat);
3773    mat=(matrix)idInit(1,1);
3774  }
3775  else
3776  {
3777    MATROWS(mat)=1;
3778    mat->rank=1;
3779    idTest((ideal)mat);
3780  }
3781  res->data=(char *)mat;
3782  return FALSE;
3783}
3784static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
3785{
3786  map m=(map)v->CopyD(MAP_CMD);
3787  omFree((ADDRESS)m->preimage);
3788  m->preimage=NULL;
3789  ideal I=(ideal)m;
3790  I->rank=1;
3791  res->data=(char *)I;
3792  return FALSE;
3793}
3794static BOOLEAN jjIDEAL_R(leftv res, leftv v)
3795{
3796  if (currRing!=NULL)
3797  {
3798    ring q=(ring)v->Data();
3799    if (rSamePolyRep(currRing, q))
3800    {
3801      if (q->qideal==NULL)
3802        res->data=(char *)idInit(1,1);
3803      else
3804        res->data=(char *)idCopy(q->qideal);
3805      return FALSE;
3806    }
3807  }
3808  WerrorS("can only get ideal from identical qring");
3809  return TRUE;
3810}
3811static BOOLEAN jjIm2Iv(leftv res, leftv v)
3812{
3813  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
3814  iv->makeVector();
3815  res->data = iv;
3816  return FALSE;
3817}
3818static BOOLEAN jjIMPART(leftv res, leftv v)
3819{
3820  res->data = (char *)nImPart((number)v->Data());
3821  return FALSE;
3822}
3823static BOOLEAN jjINDEPSET(leftv res, leftv v)
3824{
3825  assumeStdFlag(v);
3826  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
3827  return FALSE;
3828}
3829static BOOLEAN jjINTERRED(leftv res, leftv v)
3830{
3831  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
3832  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
3833  res->data = result;
3834  return FALSE;
3835}
3836static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
3837{
3838  res->data = (char *)(long)pVar((poly)v->Data());
3839  return FALSE;
3840}
3841static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
3842{
3843  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
3844  return FALSE;
3845}
3846static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
3847{
3848  res->data = (char *)0;
3849  return FALSE;
3850}
3851static BOOLEAN jjJACOB_P(leftv res, leftv v)
3852{
3853  ideal i=idInit(pVariables,1);
3854  int k;
3855  poly p=(poly)(v->Data());
3856  for (k=pVariables;k>0;k--)
3857  {
3858    i->m[k-1]=pDiff(p,k);
3859  }
3860  res->data = (char *)i;
3861  return FALSE;
3862}
3863/*2
3864 * compute Jacobi matrix of a module/matrix
3865 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables))  ),
3866 * where Mt := transpose(M)
3867 * Note that this is consistent with the current conventions for jacob in Singular,
3868 * whereas M2 computes its transposed.
3869 */
3870static BOOLEAN jjJACOB_M(leftv res, leftv a)
3871{
3872  ideal id = (ideal)a->Data();
3873  id = idTransp(id);
3874  int W = IDELEMS(id);
3875
3876  ideal result = idInit(W * pVariables, id->rank);
3877  poly *p = result->m;
3878
3879  for( int v = 1; v <= pVariables; v++ )
3880  {
3881    poly* q = id->m;
3882    for( int i = 0; i < W; i++, p++, q++ )
3883      *p = pDiff( *q, v );
3884  }
3885  idDelete(&id);
3886
3887  res->data = (char *)result;
3888  return FALSE;
3889}
3890
3891
3892static BOOLEAN jjKBASE(leftv res, leftv v)
3893{
3894  assumeStdFlag(v);
3895  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
3896  return FALSE;
3897}
3898#ifdef MDEBUG
3899static BOOLEAN jjpHead(leftv res, leftv v)
3900{
3901  res->data=(char *)pHead((poly)v->Data());
3902  return FALSE;
3903}
3904#endif
3905static BOOLEAN jjL2R(leftv res, leftv v)
3906{
3907  res->data=(char *)syConvList((lists)v->Data());
3908  if (res->data != NULL)
3909    return FALSE;
3910  else
3911    return TRUE;
3912}
3913static BOOLEAN jjLEADCOEF(leftv res, leftv v)
3914{
3915  poly p=(poly)v->Data();
3916  if (p==NULL)
3917  {
3918    res->data=(char *)nInit(0);
3919  }
3920  else
3921  {
3922    res->data=(char *)nCopy(pGetCoeff(p));
3923  }
3924  return FALSE;
3925}
3926static BOOLEAN jjLEADEXP(leftv res, leftv v)
3927{
3928  poly p=(poly)v->Data();
3929  int s=pVariables;
3930  if (v->Typ()==VECTOR_CMD) s++;
3931  intvec *iv=new intvec(s);
3932  if (p!=NULL)
3933  {
3934    for(int i = pVariables;i;i--)
3935    {
3936      (*iv)[i-1]=pGetExp(p,i);
3937    }
3938    if (s!=pVariables)
3939      (*iv)[pVariables]=pGetComp(p);
3940  }
3941  res->data=(char *)iv;
3942  return FALSE;
3943}
3944static BOOLEAN jjLEADMONOM(leftv res, leftv v)
3945{
3946  poly p=(poly)v->Data();
3947  if (p == NULL)
3948  {
3949    res->data = (char*) NULL;
3950  }
3951  else
3952  {
3953    poly lm = pLmInit(p);
3954    pSetCoeff(lm, nInit(1));
3955    res->data = (char*) lm;
3956  }
3957  return FALSE;
3958}
3959static BOOLEAN jjLOAD1(leftv res, leftv v)
3960{
3961  return jjLOAD(res, v,FALSE);
3962}
3963static BOOLEAN jjLISTRING(leftv res, leftv v)
3964{
3965  ring r=rCompose((lists)v->Data());
3966  if (r==NULL) return TRUE;
3967  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
3968  res->data=(char *)r;
3969  return FALSE;
3970}
3971#if SIZEOF_LONG == 8
3972static number jjLONG2N(long d)
3973{
3974  int i=(int)d;
3975  if ((long)i == d)
3976  {
3977    return nlInit(i, NULL);
3978  }
3979  else
3980  {
3981#if !defined(OM_NDEBUG) && !defined(NDEBUG)
3982    omCheckBin(rnumber_bin);
3983#endif
3984    number z=(number)omAllocBin(rnumber_bin);
3985    #if defined(LDEBUG)
3986    z->debug=123456;
3987    #endif
3988    z->s=3;
3989    mpz_init_set_si(z->z,d);
3990    return z;
3991  }
3992}
3993#else
3994#define jjLONG2N(D) nlInit((int)D, NULL)
3995#endif
3996static BOOLEAN jjPFAC1(leftv res, leftv v)
3997{
3998  /* call method jjPFAC2 with second argument = 0 (meaning that no
3999     valid bound for the prime factors has been given) */
4000  sleftv tmp;
4001  memset(&tmp, 0, sizeof(tmp));
4002  tmp.rtyp = INT_CMD;
4003  return jjPFAC2(res, v, &tmp);
4004}
4005static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4006{
4007  /* computes the LU-decomposition of a matrix M;
4008     i.e., M = P * L * U, where
4009        - P is a row permutation matrix,
4010        - L is in lower triangular form,
4011        - U is in upper row echelon form
4012     Then, we also have P * M = L * U.
4013     A list [P, L, U] is returned. */
4014  matrix mat = (const matrix)v->Data();
4015  int rr = mat->rows();
4016  int cc = mat->cols();
4017  matrix pMat;
4018  matrix lMat;
4019  matrix uMat;
4020
4021  luDecomp(mat, pMat, lMat, uMat);
4022
4023  lists ll = (lists)omAllocBin(slists_bin);
4024  ll->Init(3);
4025  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4026  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4027  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4028  res->data=(char*)ll;
4029
4030  return FALSE;
4031}
4032static BOOLEAN jjMEMORY(leftv res, leftv v)
4033{
4034  omUpdateInfo();
4035  long d;
4036  switch(((int)(long)v->Data()))
4037  {
4038  case 0:
4039    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4040    break;
4041  case 1:
4042    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4043    break;
4044  case 2:
4045    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4046    break;
4047  default:
4048    omPrintStats(stdout);
4049    omPrintInfo(stdout);
4050    omPrintBinStats(stdout);
4051    res->data = (char *)0;
4052    res->rtyp = NONE;
4053  }
4054  return FALSE;
4055  res->data = (char *)0;
4056  return FALSE;
4057}
4058//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4059//{
4060//  return jjMONITOR2(res,v,NULL);
4061//}
4062static BOOLEAN jjMSTD(leftv res, leftv v)
4063{
4064  int t=v->Typ();
4065  ideal r,m;
4066  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4067  lists l=(lists)omAllocBin(slists_bin);
4068  l->Init(2);
4069  l->m[0].rtyp=t;
4070  l->m[0].data=(char *)r;
4071  setFlag(&(l->m[0]),FLAG_STD);
4072  l->m[1].rtyp=t;
4073  l->m[1].data=(char *)m;
4074  res->data=(char *)l;
4075  return FALSE;
4076}
4077static BOOLEAN jjMULT(leftv res, leftv v)
4078{
4079  assumeStdFlag(v);
4080  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4081  return FALSE;
4082}
4083static BOOLEAN jjMINRES_R(leftv res, leftv v)
4084{
4085  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4086  res->data=(char *)syMinimize((syStrategy)v->Data());
4087  if (weights!=NULL)
4088    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4089  return FALSE;
4090}
4091static BOOLEAN jjN2BI(leftv res, leftv v)
4092{
4093  number n,i; i=(number)v->Data();
4094  if (rField_is_Zp())
4095  {
4096    n=nlInit(npInt(i,currRing),NULL);
4097  }
4098  else if (rField_is_Q()) n=nlBigInt(i);
4099#ifdef HAVE_RINGS
4100  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
4101  else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
4102#endif
4103  else goto err;
4104  res->data=(void *)n;
4105  return FALSE;
4106err:
4107  WerrorS("cannot convert to bigint"); return TRUE;
4108}
4109static BOOLEAN jjNAMEOF(leftv res, leftv v)
4110{
4111  res->data = (char *)v->name;
4112  if (res->data==NULL) res->data=omStrDup("");
4113  v->name=NULL;
4114  return FALSE;
4115}
4116static BOOLEAN jjNAMES(leftv res, leftv v)
4117{
4118  res->data=ipNameList(((ring)v->Data())->idroot);
4119  return FALSE;
4120}
4121static BOOLEAN jjNVARS(leftv res, leftv v)
4122{
4123  res->data = (char *)(long)(((ring)(v->Data()))->N);
4124  return FALSE;
4125}
4126static BOOLEAN jjOpenClose(leftv res, leftv v)
4127{
4128  si_link l=(si_link)v->Data();
4129  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4130  else                return slClose(l);
4131}
4132static BOOLEAN jjORD(leftv res, leftv v)
4133{
4134  poly p=(poly)v->Data();
4135  res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
4136  return FALSE;
4137}
4138static BOOLEAN jjPAR1(leftv res, leftv v)
4139{
4140  int i=(int)(long)v->Data();
4141  int p=0;
4142  p=rPar(currRing);
4143  if ((0<i) && (i<=p))
4144  {
4145    res->data=(char *)nPar(i);
4146  }
4147  else
4148  {
4149    Werror("par number %d out of range 1..%d",i,p);
4150    return TRUE;
4151  }
4152  return FALSE;
4153}
4154static BOOLEAN jjPARDEG(leftv res, leftv v)
4155{
4156  res->data = (char *)(long)nParDeg((number)v->Data());
4157  return FALSE;
4158}
4159static BOOLEAN jjPARSTR1(leftv res, leftv v)
4160{
4161  if (currRing==NULL)
4162  {
4163    WerrorS("no ring active");
4164    return TRUE;
4165  }
4166  int i=(int)(long)v->Data();
4167  int p=0;
4168  if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
4169    res->data=omStrDup(currRing->parameter[i-1]);
4170  else
4171  {
4172    Werror("par number %d out of range 1..%d",i,p);
4173    return TRUE;
4174  }
4175  return FALSE;
4176}
4177static BOOLEAN jjP2BI(leftv res, leftv v)
4178{
4179  poly p=(poly)v->Data();
4180  if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
4181  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4182  {
4183    WerrorS("poly must be constant");
4184    return TRUE;
4185  }
4186  number i=pGetCoeff(p);
4187  number n;
4188  if (rField_is_Zp())
4189  {
4190    n=nlInit(npInt(i,currRing), NULL);
4191  }
4192  else if (rField_is_Q()) n=nlBigInt(i);
4193#ifdef HAVE_RINGS
4194  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
4195    n=nlMapGMP(i);
4196  else if (rField_is_Ring_2toM())
4197    n=nlInit((unsigned long) i, NULL);
4198#endif
4199  else goto err;
4200  res->data=(void *)n;
4201  return FALSE;
4202err:
4203  WerrorS("cannot convert to bigint"); return TRUE;
4204}
4205static BOOLEAN jjP2I(leftv res, leftv v)
4206{
4207  poly p=(poly)v->Data();
4208  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4209  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4210  {
4211    WerrorS("poly must be constant");
4212    return TRUE;
4213  }
4214  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
4215  return FALSE;
4216}
4217static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4218{
4219  map mapping=(map)v->Data();
4220  syMake(res,omStrDup(mapping->preimage));
4221  return FALSE;
4222}
4223static BOOLEAN jjPRIME(leftv res, leftv v)
4224{
4225  int i = IsPrime((int)(long)(v->Data()));
4226  res->data = (char *)(long)(i > 1 ? i : 2);
4227  return FALSE;
4228}
4229static BOOLEAN jjPRUNE(leftv res, leftv v)
4230{
4231  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4232  ideal v_id=(ideal)v->Data();
4233  if (w!=NULL)
4234  {
4235    if (!idTestHomModule(v_id,currQuotient,w))
4236    {
4237      WarnS("wrong weights");
4238      w=NULL;
4239      // and continue at the non-homog case below
4240    }
4241    else
4242    {
4243      w=ivCopy(w);
4244      intvec **ww=&w;
4245      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4246      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4247      return FALSE;
4248    }
4249  }
4250  res->data = (char *)idMinEmbedding(v_id);
4251  return FALSE;
4252}
4253static BOOLEAN jjP2N(leftv res, leftv v)
4254{
4255  number n;
4256  poly p;
4257  if (((p=(poly)v->Data())!=NULL)
4258  && (pIsConstant(p)))
4259  {
4260    n=nCopy(pGetCoeff(p));
4261  }
4262  else
4263  {
4264    n=nInit(0);
4265  }
4266  res->data = (char *)n;
4267  return FALSE;
4268}
4269static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4270{
4271  char *s= (char *)v->Data();
4272  int i = 1;
4273  int l = strlen(s);
4274  for(i=0; i<sArithBase.nCmdUsed; i++)
4275  {
4276    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4277    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4278    {
4279      res->data = (char *)1;
4280      return FALSE;
4281    }
4282  }
4283  //res->data = (char *)0;
4284  return FALSE;
4285}
4286static BOOLEAN jjRANK1(leftv res, leftv v)
4287{
4288  matrix m =(matrix)v->Data();
4289  int rank = luRank(m, 0);
4290  res->data =(char *)(long)rank;
4291  return FALSE;
4292}
4293static BOOLEAN jjREAD(leftv res, leftv v)
4294{
4295  return jjREAD2(res,v,NULL);
4296}
4297static BOOLEAN jjREGULARITY(leftv res, leftv v)
4298{
4299  res->data = (char *)(long)iiRegularity((lists)v->Data());
4300  return FALSE;
4301}
4302static BOOLEAN jjREPART(leftv res, leftv v)
4303{
4304  res->data = (char *)nRePart((number)v->Data());
4305  return FALSE;
4306}
4307static BOOLEAN jjRINGLIST(leftv res, leftv v)
4308{
4309  ring r=(ring)v->Data();
4310  if (r!=NULL)
4311    res->data = (char *)rDecompose((ring)v->Data());
4312  return (r==NULL)||(res->data==NULL);
4313}
4314static BOOLEAN jjROWS(leftv res, leftv v)
4315{
4316  ideal i = (ideal)v->Data();
4317  res->data = (char *)i->rank;
4318  return FALSE;
4319}
4320static BOOLEAN jjROWS_IV(leftv res, leftv v)
4321{
4322  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4323  return FALSE;
4324}
4325static BOOLEAN jjRPAR(leftv res, leftv v)
4326{
4327  res->data = (char *)(long)rPar(((ring)v->Data()));
4328  return FALSE;
4329}
4330static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4331{
4332#ifdef HAVE_PLURAL
4333  const bool bIsSCA = rIsSCA(currRing);
4334#else
4335  const bool bIsSCA = false;
4336#endif
4337
4338  if ((currQuotient!=NULL) && !bIsSCA)
4339  {
4340    WerrorS("qring not supported by slimgb at the moment");
4341    return TRUE;
4342  }
4343  if (rHasLocalOrMixedOrdering_currRing())
4344  {
4345    WerrorS("ordering must be global for slimgb");
4346    return TRUE;
4347  }
4348  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4349  tHomog hom=testHomog;
4350  ideal u_id=(ideal)u->Data();
4351  if (w!=NULL)
4352  {
4353    if (!idTestHomModule(u_id,currQuotient,w))
4354    {
4355      WarnS("wrong weights");
4356      w=NULL;
4357    }
4358    else
4359    {
4360      w=ivCopy(w);
4361      hom=isHomog;
4362    }
4363  }
4364
4365  assume(u_id->rank>=idRankFreeModule(u_id));
4366  res->data=(char *)t_rep_gb(currRing,
4367    u_id,u_id->rank);
4368  //res->data=(char *)t_rep_gb(currRing, u_id);
4369
4370  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4371  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4372  return FALSE;
4373}
4374static BOOLEAN jjSTD(leftv res, leftv v)
4375{
4376  ideal result;
4377  ideal v_id=(ideal)v->Data();
4378  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4379  tHomog hom=testHomog;
4380  if (w!=NULL)
4381  {
4382    if (!idTestHomModule(v_id,currQuotient,w))
4383    {
4384      WarnS("wrong weights");
4385      w=NULL;
4386    }
4387    else
4388    {
4389      hom=isHomog;
4390      w=ivCopy(w);
4391    }
4392  }
4393  result=kStd(v_id,currQuotient,hom,&w);
4394  idSkipZeroes(result);
4395  res->data = (char *)result;
4396  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4397  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4398  return FALSE;
4399}
4400static BOOLEAN jjSort_Id(leftv res, leftv v)
4401{
4402  res->data = (char *)idSort((ideal)v->Data());
4403  return FALSE;
4404}
4405#ifdef HAVE_FACTORY
4406extern int singclap_factorize_retry;
4407static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4408{
4409  intvec *v=NULL;
4410  singclap_factorize_retry=0;
4411  ideal f=singclap_sqrfree((poly)(u->CopyD()));
4412  if (f==NULL)
4413    return TRUE;
4414  res->data=(void *)f;
4415  return FALSE;
4416}
4417#endif
4418#if 1
4419static BOOLEAN jjSYZYGY(leftv res, leftv v)
4420{
4421  intvec *w=NULL;
4422  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4423  if (w!=NULL) delete w;
4424  return FALSE;
4425}
4426#else
4427// activate, if idSyz handle module weights correctly !
4428static BOOLEAN jjSYZYGY(leftv res, leftv v)
4429{
4430  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4431  ideal v_id=(ideal)v->Data();
4432  tHomog hom=testHomog;
4433  int add_row_shift=0;
4434  if (w!=NULL)
4435  {
4436    w=ivCopy(w);
4437    add_row_shift=w->min_in();
4438    (*w)-=add_row_shift;
4439    if (idTestHomModule(v_id,currQuotient,w))
4440      hom=isHomog;
4441    else
4442    {
4443      //WarnS("wrong weights");
4444      delete w; w=NULL;
4445      hom=testHomog;
4446    }
4447  }
4448  res->data = (char *)idSyzygies(v_id,hom,&w);
4449  if (w!=NULL)
4450  {
4451    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4452  }
4453  return FALSE;
4454}
4455#endif
4456static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4457{
4458  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4459  return FALSE;
4460}
4461static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4462{
4463  res->data = (char *)ivTranp((intvec*)(v->Data()));
4464  return FALSE;
4465}
4466#ifdef HAVE_PLURAL
4467static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4468{
4469  ring    r = (ring)a->Data();
4470  //if (rIsPluralRing(r))
4471  if (r->OrdSgn==1)
4472  {
4473    res->data = rOpposite(r);
4474  }
4475  else
4476  {
4477    WarnS("opposite only for global orderings");
4478    res->data = rCopy(r);
4479  }
4480  return FALSE;
4481}
4482static BOOLEAN jjENVELOPE(leftv res, leftv a)
4483{
4484  ring    r = (ring)a->Data();
4485  if (rIsPluralRing(r))
4486  {
4487    //    ideal   i;
4488//     if (a->rtyp == QRING_CMD)
4489//     {
4490//       i = r->qideal;
4491//       r->qideal = NULL;
4492//     }
4493    ring s = rEnvelope(r);
4494//     if (a->rtyp == QRING_CMD)
4495//     {
4496//       ideal is  = idOppose(r,i); /* twostd? */
4497//       is        = idAdd(is,i);
4498//       s->qideal = i;
4499//     }
4500    res->data = s;
4501  }
4502  else  res->data = rCopy(r);
4503  return FALSE;
4504}
4505static BOOLEAN jjTWOSTD(leftv res, leftv a)
4506{
4507  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4508  else  res->data=(ideal)a->CopyD();
4509  setFlag(res,FLAG_STD);
4510  setFlag(res,FLAG_TWOSTD);
4511  return FALSE;
4512}
4513#endif
4514
4515static BOOLEAN jjTYPEOF(leftv res, leftv v)
4516{
4517  int t=(int)(long)v->data;
4518  switch (t)
4519  {
4520    case INT_CMD:        res->data=omStrDup("int"); break;
4521    case POLY_CMD:       res->data=omStrDup("poly"); break;
4522    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
4523    case STRING_CMD:     res->data=omStrDup("string"); break;
4524    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
4525    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
4526    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
4527    case MODUL_CMD:      res->data=omStrDup("module"); break;
4528    case MAP_CMD:        res->data=omStrDup("map"); break;
4529    case PROC_CMD:       res->data=omStrDup("proc"); break;
4530    case RING_CMD:       res->data=omStrDup("ring"); break;
4531    case QRING_CMD:      res->data=omStrDup("qring"); break;
4532    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
4533    case NUMBER_CMD:     res->data=omStrDup("number"); break;
4534    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
4535    case LIST_CMD:       res->data=omStrDup("list"); break;
4536    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
4537    case LINK_CMD:       res->data=omStrDup("link"); break;
4538    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
4539    case DEF_CMD:
4540    case NONE:           res->data=omStrDup("none"); break;
4541    default:
4542    {
4543      if (t>MAX_TOK)
4544        res->data=omStrDup(getBlackboxName(t));
4545      else
4546        res->data=omStrDup("?unknown type?");
4547      break;
4548    }
4549  }
4550  return FALSE;
4551}
4552static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
4553{
4554  res->data=(char *)pIsUnivariate((poly)v->Data());
4555  return FALSE;
4556}
4557static BOOLEAN jjVAR1(leftv res, leftv v)
4558{
4559  int i=(int)(long)v->Data();
4560  if ((0<i) && (i<=currRing->N))
4561  {
4562    poly p=pOne();
4563    pSetExp(p,i,1);
4564    pSetm(p);
4565    res->data=(char *)p;
4566  }
4567  else
4568  {
4569    Werror("var number %d out of range 1..%d",i,currRing->N);
4570    return TRUE;
4571  }
4572  return FALSE;
4573}
4574static BOOLEAN jjVARSTR1(leftv res, leftv v)
4575{
4576  if (currRing==NULL)
4577  {
4578    WerrorS("no ring active");
4579    return TRUE;
4580  }
4581  int i=(int)(long)v->Data();
4582  if ((0<i) && (i<=currRing->N))
4583    res->data=omStrDup(currRing->names[i-1]);
4584  else
4585  {
4586    Werror("var number %d out of range 1..%d",i,currRing->N);
4587    return TRUE;
4588  }
4589  return FALSE;
4590}
4591static BOOLEAN jjVDIM(leftv res, leftv v)
4592{
4593  assumeStdFlag(v);
4594  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
4595  return FALSE;
4596}
4597BOOLEAN jjWAIT1ST1(leftv res, leftv a)
4598{
4599  lists Lforks = (lists)a->Data();
4600  int i = slStatusSsiL(Lforks, -1);
4601  while (i <= 0) i = slStatusSsiL(Lforks, 10000000); /* redo this all 10 seconds */
4602  res->data = (void*)(long)i;
4603  return FALSE;
4604}
4605BOOLEAN jjWAITALL1(leftv res, leftv a)
4606{
4607  lists Lforks = (lists)a->Data();
4608  lists oneFork=(lists)omAllocBin(slists_bin);
4609  oneFork->Init(1);
4610  int i;
4611  for (int j = 0; j <= Lforks->nr; j++)
4612  {
4613    oneFork->m[0].Copy(&Lforks->m[j]);
4614    i = slStatusSsiL(oneFork, -1);
4615    while (i != 1) i = slStatusSsiL(oneFork, 10000000); /* redo this all 10 seconds */
4616    omFreeSize((ADDRESS)oneFork->m,sizeof(sleftv));
4617  }
4618  omFreeBin((ADDRESS)oneFork, slists_bin);
4619  return FALSE;
4620}
4621static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
4622{
4623  char * s=(char *)v->CopyD();
4624  char libnamebuf[256];
4625  lib_types LT = type_of_LIB(s, libnamebuf);
4626#ifdef HAVE_DYNAMIC_LOADING
4627  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
4628#endif /* HAVE_DYNAMIC_LOADING */
4629  switch(LT)
4630  {
4631      default:
4632      case LT_NONE:
4633        Werror("%s: unknown type", s);
4634        break;
4635      case LT_NOTFOUND:
4636        Werror("cannot open %s", s);
4637        break;
4638
4639      case LT_SINGULAR:
4640      {
4641        char *plib = iiConvName(s);
4642        idhdl pl = IDROOT->get(plib,0);
4643        if (pl==NULL)
4644        {
4645          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
4646          IDPACKAGE(pl)->language = LANG_SINGULAR;
4647          IDPACKAGE(pl)->libname=omStrDup(plib);
4648        }
4649        else if (IDTYP(pl)!=PACKAGE_CMD)
4650        {
4651          Werror("can not create package `%s`",plib);
4652          omFree(plib);
4653          return TRUE;
4654        }
4655        package savepack=currPack;
4656        currPack=IDPACKAGE(pl);
4657        IDPACKAGE(pl)->loaded=TRUE;
4658        char libnamebuf[256];
4659        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
4660        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
4661        currPack=savepack;
4662        IDPACKAGE(pl)->loaded=(!bo);
4663        return bo;
4664      }
4665      case LT_MACH_O:
4666      case LT_ELF:
4667      case LT_HPUX:
4668#ifdef HAVE_DYNAMIC_LOADING
4669        return load_modules(s, libnamebuf, autoexport);
4670#else /* HAVE_DYNAMIC_LOADING */
4671        WerrorS("Dynamic modules are not supported by this version of Singular");
4672        break;
4673#endif /* HAVE_DYNAMIC_LOADING */
4674  }
4675  return TRUE;
4676}
4677
4678#ifdef INIT_BUG
4679#define XS(A) -((short)A)
4680#define jjstrlen       (proc1)1
4681#define jjpLength      (proc1)2
4682#define jjidElem       (proc1)3
4683#define jjmpDetBareiss (proc1)4
4684#define jjidFreeModule (proc1)5
4685#define jjidVec2Ideal  (proc1)6
4686#define jjrCharStr     (proc1)7
4687#ifndef MDEBUG
4688#define jjpHead        (proc1)8
4689#endif
4690#define jjidHead       (proc1)9
4691#define jjidMaxIdeal   (proc1)10
4692#define jjidMinBase    (proc1)11
4693#define jjsyMinBase    (proc1)12
4694#define jjpMaxComp     (proc1)13
4695#define jjmpTrace      (proc1)14
4696#define jjmpTransp     (proc1)15
4697#define jjrOrdStr      (proc1)16
4698#define jjrVarStr      (proc1)18
4699#define jjrParStr      (proc1)19
4700#define jjCOUNT_RES    (proc1)22
4701#define jjDIM_R        (proc1)23
4702#define jjidTransp     (proc1)24
4703
4704extern struct sValCmd1 dArith1[];
4705void jjInitTab1()
4706{
4707  int i=0;
4708  for (;dArith1[i].cmd!=0;i++)
4709  {
4710    if (dArith1[i].res<0)
4711    {
4712      switch ((int)dArith1[i].p)
4713      {
4714        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
4715        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
4716        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
4717        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
4718#ifndef HAVE_FACTORY
4719        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
4720#endif
4721        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
4722        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
4723#ifndef MDEBUG
4724        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
4725#endif
4726        case (int)jjidHead:       dArith1[i].p=(proc1)idHead; break;
4727        case (int)jjidMaxIdeal:   dArith1[i].p=(proc1)idMaxIdeal; break;
4728        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
4729        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
4730        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
4731        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
4732        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
4733        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
4734        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
4735        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
4736        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
4737        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
4738        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
4739        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
4740      }
4741    }
4742  }
4743}
4744#else
4745#if defined(PROC_BUG)
4746#define XS(A) A
4747static BOOLEAN jjstrlen(leftv res, leftv v)
4748{
4749  res->data = (char *)strlen((char *)v->Data());
4750  return FALSE;
4751}
4752static BOOLEAN jjpLength(leftv res, leftv v)
4753{
4754  res->data = (char *)pLength((poly)v->Data());
4755  return FALSE;
4756}
4757static BOOLEAN jjidElem(leftv res, leftv v)
4758{
4759  res->data = (char *)idElem((ideal)v->Data());
4760  return FALSE;
4761}
4762static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
4763{
4764  res->data = (char *)mpDetBareiss((matrix)v->Data());
4765  return FALSE;
4766}
4767static BOOLEAN jjidFreeModule(leftv res, leftv v)
4768{
4769  res->data = (char *)idFreeModule((int)(long)v->Data());
4770  return FALSE;
4771}
4772static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
4773{
4774  res->data = (char *)idVec2Ideal((poly)v->Data());
4775  return FALSE;
4776}
4777static BOOLEAN jjrCharStr(leftv res, leftv v)
4778{
4779  res->data = rCharStr((ring)v->Data());
4780  return FALSE;
4781}
4782#ifndef MDEBUG
4783static BOOLEAN jjpHead(leftv res, leftv v)
4784{
4785  res->data = (char *)pHead((poly)v->Data());
4786  return FALSE;
4787}
4788#endif
4789static BOOLEAN jjidHead(leftv res, leftv v)
4790{
4791  res->data = (char *)idHead((ideal)v->Data());
4792  return FALSE;
4793}
4794static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4795{
4796  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4797  return FALSE;
4798}
4799static BOOLEAN jjidMinBase(leftv res, leftv v)
4800{
4801  res->data = (char *)idMinBase((ideal)v->Data());
4802  return FALSE;
4803}
4804static BOOLEAN jjsyMinBase(leftv res, leftv v)
4805{
4806  res->data = (char *)syMinBase((ideal)v->Data());
4807  return FALSE;
4808}
4809static BOOLEAN jjpMaxComp(leftv res, leftv v)
4810{
4811  res->data = (char *)pMaxComp((poly)v->Data());
4812  return FALSE;
4813}
4814static BOOLEAN jjmpTrace(leftv res, leftv v)
4815{
4816  res->data = (char *)mpTrace((matrix)v->Data());
4817  return FALSE;
4818}
4819static BOOLEAN jjmpTransp(leftv res, leftv v)
4820{
4821  res->data = (char *)mpTransp((matrix)v->Data());
4822  return FALSE;
4823}
4824static BOOLEAN jjrOrdStr(leftv res, leftv v)
4825{
4826  res->data = rOrdStr((ring)v->Data());
4827  return FALSE;
4828}
4829static BOOLEAN jjrVarStr(leftv res, leftv v)
4830{
4831  res->data = rVarStr((ring)v->Data());
4832  return FALSE;
4833}
4834static BOOLEAN jjrParStr(leftv res, leftv v)
4835{
4836  res->data = rParStr((ring)v->Data());
4837  return FALSE;
4838}
4839static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
4840{
4841  res->data=(char *)sySize((syStrategy)v->Data());
4842  return FALSE;
4843}
4844static BOOLEAN jjDIM_R(leftv res, leftv v)
4845{
4846  res->data = (char *)syDim((syStrategy)v->Data());
4847  return FALSE;
4848}
4849static BOOLEAN jjidTransp(leftv res, leftv v)
4850{
4851  res->data = (char *)idTransp((ideal)v->Data());
4852  return FALSE;
4853}
4854#else
4855#define XS(A)          -((short)A)
4856#define jjstrlen       (proc1)strlen
4857#define jjpLength      (proc1)pLength
4858#define jjidElem       (proc1)idElem
4859#define jjmpDetBareiss (proc1)mpDetBareiss
4860#define jjidFreeModule (proc1)idFreeModule
4861#define jjidVec2Ideal  (proc1)idVec2Ideal
4862#define jjrCharStr     (proc1)rCharStr
4863#ifndef MDEBUG
4864#define jjpHead        (proc1)pHeadProc
4865#endif
4866#define jjidHead       (proc1)idHead
4867#define jjidMaxIdeal   (proc1)idMaxIdeal
4868#define jjidMinBase    (proc1)idMinBase
4869#define jjsyMinBase    (proc1)syMinBase
4870#define jjpMaxComp     (proc1)pMaxCompProc
4871#define jjmpTrace      (proc1)mpTrace
4872#define jjmpTransp     (proc1)mpTransp
4873#define jjrOrdStr      (proc1)rOrdStr
4874#define jjrVarStr      (proc1)rVarStr
4875#define jjrParStr      (proc1)rParStr
4876#define jjCOUNT_RES    (proc1)sySize
4877#define jjDIM_R        (proc1)syDim
4878#define jjidTransp     (proc1)idTransp
4879#endif
4880#endif
4881static BOOLEAN jjnInt(leftv res, leftv u)
4882{
4883  number n=(number)u->Data();
4884  res->data=(char *)(long)n_Int(n,currRing);
4885  return FALSE;
4886}
4887static BOOLEAN jjnlInt(leftv res, leftv u)
4888{
4889  number n=(number)u->Data();
4890  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
4891  return FALSE;
4892}
4893/*=================== operations with 3 args.: static proc =================*/
4894/* must be ordered: first operations for chars (infix ops),
4895 * then alphabetically */
4896static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
4897{
4898  char *s= (char *)u->Data();
4899  int   r = (int)(long)v->Data();
4900  int   c = (int)(long)w->Data();
4901  int l = strlen(s);
4902
4903  if ( (r<1) || (r>l) || (c<0) )
4904  {
4905    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
4906    return TRUE;
4907  }
4908  res->data = (char *)omAlloc((long)(c+1));
4909  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
4910  return FALSE;
4911}
4912static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
4913{
4914  intvec *iv = (intvec *)u->Data();
4915  int   r = (int)(long)v->Data();
4916  int   c = (int)(long)w->Data();
4917  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
4918  {
4919    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
4920           r,c,u->Fullname(),iv->rows(),iv->cols());
4921    return TRUE;
4922  }
4923  res->data=u->data; u->data=NULL;
4924  res->rtyp=u->rtyp; u->rtyp=0;
4925  res->name=u->name; u->name=NULL;
4926  Subexpr e=jjMakeSub(v);
4927          e->next=jjMakeSub(w);
4928  if (u->e==NULL) res->e=e;
4929  else
4930  {
4931    Subexpr h=u->e;
4932    while (h->next!=NULL) h=h->next;
4933    h->next=e;
4934    res->e=u->e;
4935    u->e=NULL;
4936  }
4937  return FALSE;
4938}
4939static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
4940{
4941  matrix m= (matrix)u->Data();
4942  int   r = (int)(long)v->Data();
4943  int   c = (int)(long)w->Data();
4944  //Print("gen. elem %d, %d\n",r,c);
4945  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
4946  {
4947    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
4948      MATROWS(m),MATCOLS(m));
4949    return TRUE;
4950  }
4951  res->data=u->data; u->data=NULL;
4952  res->rtyp=u->rtyp; u->rtyp=0;
4953  res->name=u->name; u->name=NULL;
4954  Subexpr e=jjMakeSub(v);
4955          e->next=jjMakeSub(w);
4956  if (u->e==NULL)
4957    res->e=e;
4958  else
4959  {
4960    Subexpr h=u->e;
4961    while (h->next!=NULL) h=h->next;
4962    h->next=e;
4963    res->e=u->e;
4964    u->e=NULL;
4965  }
4966  return FALSE;
4967}
4968static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
4969{
4970  sleftv t;
4971  sleftv ut;
4972  leftv p=NULL;
4973  intvec *iv=(intvec *)w->Data();
4974  int l;
4975  BOOLEAN nok;
4976
4977  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
4978  {
4979    WerrorS("cannot build expression lists from unnamed objects");
4980    return TRUE;
4981  }
4982  memcpy(&ut,u,sizeof(ut));
4983  memset(&t,0,sizeof(t));
4984  t.rtyp=INT_CMD;
4985  for (l=0;l< iv->length(); l++)
4986  {
4987    t.data=(char *)(long)((*iv)[l]);
4988    if (p==NULL)
4989    {
4990      p=res;
4991    }
4992    else
4993    {
4994      p->next=(leftv)omAlloc0Bin(sleftv_bin);
4995      p=p->next;
4996    }
4997    memcpy(u,&ut,sizeof(ut));
4998    if (u->Typ() == MATRIX_CMD)
4999      nok=jjBRACK_Ma(p,u,v,&t);
5000    else /* INTMAT_CMD */
5001      nok=jjBRACK_Im(p,u,v,&t);
5002    if (nok)
5003    {
5004      while (res->next!=NULL)
5005      {
5006        p=res->next->next;
5007        omFreeBin((ADDRESS)res->next, sleftv_bin);
5008        // res->e aufraeumen !!!!
5009        res->next=p;
5010      }
5011      return TRUE;
5012    }
5013  }
5014  return FALSE;
5015}
5016static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5017{
5018  sleftv t;
5019  sleftv ut;
5020  leftv p=NULL;
5021  intvec *iv=(intvec *)v->Data();
5022  int l;
5023  BOOLEAN nok;
5024
5025  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5026  {
5027    WerrorS("cannot build expression lists from unnamed objects");
5028    return TRUE;
5029  }
5030  memcpy(&ut,u,sizeof(ut));
5031  memset(&t,0,sizeof(t));
5032  t.rtyp=INT_CMD;
5033  for (l=0;l< iv->length(); l++)
5034  {
5035    t.data=(char *)(long)((*iv)[l]);
5036    if (p==NULL)
5037    {
5038      p=res;
5039    }
5040    else
5041    {
5042      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5043      p=p->next;
5044    }
5045    memcpy(u,&ut,sizeof(ut));
5046    if (u->Typ() == MATRIX_CMD)
5047      nok=jjBRACK_Ma(p,u,&t,w);
5048    else /* INTMAT_CMD */
5049      nok=jjBRACK_Im(p,u,&t,w);
5050    if (nok)
5051    {
5052      while (res->next!=NULL)
5053      {
5054        p=res->next->next;
5055        omFreeBin((ADDRESS)res->next, sleftv_bin);
5056        // res->e aufraeumen !!
5057        res->next=p;
5058      }
5059      return TRUE;
5060    }
5061  }
5062  return FALSE;
5063}
5064static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5065{
5066  sleftv t1,t2,ut;
5067  leftv p=NULL;
5068  intvec *vv=(intvec *)v->Data();
5069  intvec *wv=(intvec *)w->Data();
5070  int vl;
5071  int wl;
5072  BOOLEAN nok;
5073
5074  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5075  {
5076    WerrorS("cannot build expression lists from unnamed objects");
5077    return TRUE;
5078  }
5079  memcpy(&ut,u,sizeof(ut));
5080  memset(&t1,0,sizeof(sleftv));
5081  memset(&t2,0,sizeof(sleftv));
5082  t1.rtyp=INT_CMD;
5083  t2.rtyp=INT_CMD;
5084  for (vl=0;vl< vv->length(); vl++)
5085  {
5086    t1.data=(char *)(long)((*vv)[vl]);
5087    for (wl=0;wl< wv->length(); wl++)
5088    {
5089      t2.data=(char *)(long)((*wv)[wl]);
5090      if (p==NULL)
5091      {
5092        p=res;
5093      }
5094      else
5095      {
5096        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5097        p=p->next;
5098      }
5099      memcpy(u,&ut,sizeof(ut));
5100      if (u->Typ() == MATRIX_CMD)
5101        nok=jjBRACK_Ma(p,u,&t1,&t2);
5102      else /* INTMAT_CMD */
5103        nok=jjBRACK_Im(p,u,&t1,&t2);
5104      if (nok)
5105      {
5106        res->CleanUp();
5107        return TRUE;
5108      }
5109    }
5110  }
5111  return FALSE;
5112}
5113static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5114{
5115  v->next=(leftv)omAllocBin(sleftv_bin);
5116  memcpy(v->next,w,sizeof(sleftv));
5117  memset(w,0,sizeof(sleftv));
5118  return jjPROC(res,u,v);
5119}
5120static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5121{
5122  u->next=(leftv)omAllocBin(sleftv_bin);
5123  memcpy(u->next,v,sizeof(sleftv));
5124  u->next->next=(leftv)omAllocBin(sleftv_bin);
5125  memcpy(u->next->next,w,sizeof(sleftv));
5126  BOOLEAN r=iiExprArithM(res,u,iiOp);
5127  v->Init();
5128  w->Init();
5129  //w->rtyp=0; w->data=NULL;
5130  // iiExprArithM did the CleanUp
5131  return r;
5132}
5133static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5134{
5135  intvec *iv;
5136  ideal m;
5137  lists l=(lists)omAllocBin(slists_bin);
5138  int k=(int)(long)w->Data();
5139  if (k>=0)
5140  {
5141    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5142    l->Init(2);
5143    l->m[0].rtyp=MODUL_CMD;
5144    l->m[1].rtyp=INTVEC_CMD;
5145    l->m[0].data=(void *)m;
5146    l->m[1].data=(void *)iv;
5147  }
5148  else
5149  {
5150    m=smCallSolv((ideal)u->Data());
5151    l->Init(1);
5152    l->m[0].rtyp=IDEAL_CMD;
5153    l->m[0].data=(void *)m;
5154  }
5155  res->data = (char *)l;
5156  return FALSE;
5157}
5158static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5159{
5160  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5161  {
5162    WerrorS("3rd argument must be a name of a matrix");
5163    return TRUE;
5164  }
5165  ideal i=(ideal)u->Data();
5166  int rank=(int)i->rank;
5167  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5168  if (r) return TRUE;
5169  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5170  return FALSE;
5171}
5172static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5173{
5174  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5175           (ideal)(v->Data()),(poly)(w->Data()));
5176  return FALSE;
5177}
5178static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5179{
5180  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5181  {
5182    WerrorS("3rd argument must be a name of a matrix");
5183    return TRUE;
5184  }
5185  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5186  poly p=(poly)u->CopyD(POLY_CMD);
5187  ideal i=idInit(1,1);
5188  i->m[0]=p;
5189  sleftv t;
5190  memset(&t,0,sizeof(t));
5191  t.data=(char *)i;
5192  t.rtyp=IDEAL_CMD;
5193  int rank=1;
5194  if (u->Typ()==VECTOR_CMD)
5195  {
5196    i->rank=rank=pMaxComp(p);
5197    t.rtyp=MODUL_CMD;
5198  }
5199  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5200  t.CleanUp();
5201  if (r) return TRUE;
5202  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5203  return FALSE;
5204}
5205static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5206{
5207  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5208    (intvec *)w->Data());
5209  //setFlag(res,FLAG_STD);
5210  return FALSE;
5211}
5212static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5213{
5214  /*4
5215  * look for the substring what in the string where
5216  * starting at position n
5217  * return the position of the first char of what in where
5218  * or 0
5219  */
5220  int n=(int)(long)w->Data();
5221  char *where=(char *)u->Data();
5222  char *what=(char *)v->Data();
5223  char *found;
5224  if ((1>n)||(n>(int)strlen(where)))
5225  {
5226    Werror("start position %d out of range",n);
5227    return TRUE;
5228  }
5229  found = strchr(where+n-1,*what);
5230  if (*(what+1)!='\0')
5231  {
5232    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5233    {
5234      found=strchr(found+1,*what);
5235    }
5236  }
5237  if (found != NULL)
5238  {
5239    res->data=(char *)((found-where)+1);
5240  }
5241  return FALSE;
5242}
5243static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5244{
5245  if ((int)(long)w->Data()==0)
5246    res->data=(char *)walkProc(u,v);
5247  else
5248    res->data=(char *)fractalWalkProc(u,v);
5249  setFlag( res, FLAG_STD );
5250  return FALSE;
5251}
5252static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5253{
5254  assumeStdFlag(u);
5255  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5256  intvec *wdegree=(intvec*)w->Data();
5257  if (wdegree->length()!=pVariables)
5258  {
5259    Werror("weight vector must have size %d, not %d",
5260           pVariables,wdegree->length());
5261    return TRUE;
5262  }
5263  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5264  switch((int)(long)v->Data())
5265  {
5266    case 1:
5267      res->data=(void *)iv;
5268      return FALSE;
5269    case 2:
5270      res->data=(void *)hSecondSeries(iv);
5271      delete iv;
5272      return FALSE;
5273  }
5274  WerrorS(feNotImplemented);
5275  delete iv;
5276  return TRUE;
5277}
5278static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5279{
5280  PrintS("TODO\n");
5281  int i=pVar((poly)v->Data());
5282  if (i==0)
5283  {
5284    WerrorS("ringvar expected");
5285    return TRUE;
5286  }
5287  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5288  int d=pWTotaldegree(p);
5289  pLmDelete(p);
5290  if (d==1)
5291    res->data = (char *)idHomogen((ideal)u->Data(),i);
5292  else
5293    WerrorS("variable must have weight 1");
5294  return (d!=1);
5295}
5296static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5297{
5298  PrintS("TODO\n");
5299  int i=pVar((poly)v->Data());
5300  if (i==0)
5301  {
5302    WerrorS("ringvar expected");
5303    return TRUE;
5304  }
5305  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5306  int d=pWTotaldegree(p);
5307  pLmDelete(p);
5308  if (d==1)
5309    res->data = (char *)pHomogen((poly)u->Data(),i);
5310  else
5311    WerrorS("variable must have weight 1");
5312  return (d!=1);
5313}
5314static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5315{
5316  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5317  intvec* arg = (intvec*) u->Data();
5318  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5319
5320  for (i=0; i<n; i++)
5321  {
5322    (*im)[i] = (*arg)[i];
5323  }
5324
5325  res->data = (char *)im;
5326  return FALSE;
5327}
5328static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5329{
5330  short *iw=iv2array((intvec *)w->Data());
5331  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5332  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
5333  return FALSE;
5334}
5335static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5336{
5337  if (!pIsUnit((poly)v->Data()))
5338  {
5339    WerrorS("2nd argument must be a unit");
5340    return TRUE;
5341  }
5342  res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
5343  return FALSE;
5344}
5345static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5346{
5347  res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
5348                             (intvec *)w->Data());
5349  return FALSE;
5350}
5351static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5352{
5353  if (!mpIsDiagUnit((matrix)v->Data()))
5354  {
5355    WerrorS("2nd argument must be a diagonal matrix of units");
5356    return TRUE;
5357  }
5358  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5359                               (matrix)v->CopyD());
5360  return FALSE;
5361}
5362static BOOLEAN currRingIsOverIntegralDomain ()
5363{
5364  /* true for fields and Z, false otherwise */
5365  if (rField_is_Ring_PtoM()) return FALSE;
5366  if (rField_is_Ring_2toM()) return FALSE;
5367  if (rField_is_Ring_ModN()) return FALSE;
5368  return TRUE;
5369}
5370static BOOLEAN jjMINOR_M(leftv res, leftv v)
5371{
5372  /* Here's the use pattern for the minor command:
5373        minor ( matrix_expression m, int_expression minorSize,
5374                optional ideal_expression IasSB, optional int_expression k,
5375                optional string_expression algorithm,
5376                optional int_expression cachedMinors,
5377                optional int_expression cachedMonomials )
5378     This method here assumes that there are at least two arguments.
5379     - If IasSB is present, it must be a std basis. All minors will be
5380       reduced w.r.t. IasSB.
5381     - If k is absent, all non-zero minors will be computed.
5382       If k is present and k > 0, the first k non-zero minors will be
5383       computed.
5384       If k is present and k < 0, the first |k| minors (some of which
5385       may be zero) will be computed.
5386       If k is present and k = 0, an error is reported.
5387     - If algorithm is absent, all the following arguments must be absent too.
5388       In this case, a heuristic picks the best-suited algorithm (among
5389       Bareiss, Laplace, and Laplace with caching).
5390       If algorithm is present, it must be one of "Bareiss", "bareiss",
5391       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5392       "cache" two more arguments may be given, determining how many entries
5393       the cache may have at most, and how many cached monomials there are at
5394       most. (Cached monomials are counted over all cached polynomials.)
5395       If these two additional arguments are not provided, 200 and 100000
5396       will be used as defaults.
5397  */
5398  matrix m;
5399  leftv u=v->next;
5400  v->next=NULL;
5401  int v_typ=v->Typ();
5402  if (v_typ==MATRIX_CMD)
5403  {
5404     m = (const matrix)v->Data();
5405  }
5406  else
5407  {
5408    if (v_typ==0)
5409    {
5410      Werror("`%s` is undefined",v->Fullname());
5411      return TRUE;
5412    }
5413    // try to convert to MATRIX:
5414    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5415    BOOLEAN bo;
5416    sleftv tmp;
5417    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5418    else bo=TRUE;
5419    if (bo)
5420    {
5421      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5422      return TRUE;
5423    }
5424    m=(matrix)tmp.data;
5425  }
5426  const int mk = (const int)(long)u->Data();
5427  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5428  bool noCacheMinors = true; bool noCacheMonomials = true;
5429  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5430
5431  /* here come the different cases of correct argument sets */
5432  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5433  {
5434    IasSB = (ideal)u->next->Data();
5435    noIdeal = false;
5436    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5437    {
5438      k = (int)(long)u->next->next->Data();
5439      noK = false;
5440      assume(k != 0);
5441      if ((u->next->next->next != NULL) &&
5442          (u->next->next->next->Typ() == STRING_CMD))
5443      {
5444        algorithm = (char*)u->next->next->next->Data();
5445        noAlgorithm = false;
5446        if ((u->next->next->next->next != NULL) &&
5447            (u->next->next->next->next->Typ() == INT_CMD))
5448        {
5449          cacheMinors = (int)(long)u->next->next->next->next->Data();
5450          noCacheMinors = false;
5451          if ((u->next->next->next->next->next != NULL) &&
5452              (u->next->next->next->next->next->Typ() == INT_CMD))
5453          {
5454            cacheMonomials =
5455               (int)(long)u->next->next->next->next->next->Data();
5456            noCacheMonomials = false;
5457          }
5458        }
5459      }
5460    }
5461  }
5462  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5463  {
5464    k = (int)(long)u->next->Data();
5465    noK = false;
5466    assume(k != 0);
5467    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5468    {
5469      algorithm = (char*)u->next->next->Data();
5470      noAlgorithm = false;
5471      if ((u->next->next->next != NULL) &&
5472          (u->next->next->next->Typ() == INT_CMD))
5473      {
5474        cacheMinors = (int)(long)u->next->next->next->Data();
5475        noCacheMinors = false;
5476        if ((u->next->next->next->next != NULL) &&
5477            (u->next->next->next->next->Typ() == INT_CMD))
5478        {
5479          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5480          noCacheMonomials = false;
5481        }
5482      }
5483    }
5484  }
5485  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5486  {
5487    algorithm = (char*)u->next->Data();
5488    noAlgorithm = false;
5489    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5490    {
5491      cacheMinors = (int)(long)u->next->next->Data();
5492      noCacheMinors = false;
5493      if ((u->next->next->next != NULL) &&
5494          (u->next->next->next->Typ() == INT_CMD))
5495      {
5496        cacheMonomials = (int)(long)u->next->next->next->Data();
5497        noCacheMonomials = false;
5498      }
5499    }
5500  }
5501
5502  /* upper case conversion for the algorithm if present */
5503  if (!noAlgorithm)
5504  {
5505    if (strcmp(algorithm, "bareiss") == 0)
5506      algorithm = (char*)"Bareiss";
5507    if (strcmp(algorithm, "laplace") == 0)
5508      algorithm = (char*)"Laplace";
5509    if (strcmp(algorithm, "cache") == 0)
5510      algorithm = (char*)"Cache";
5511  }
5512
5513  v->next=u;
5514  /* here come some tests */
5515  if (!noIdeal)
5516  {
5517    assumeStdFlag(u->next);
5518  }
5519  if ((!noK) && (k == 0))
5520  {
5521    WerrorS("Provided number of minors to be computed is zero.");
5522    return TRUE;
5523  }
5524  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
5525      && (strcmp(algorithm, "Laplace") != 0)
5526      && (strcmp(algorithm, "Cache") != 0))
5527  {
5528    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
5529    return TRUE;
5530  }
5531  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
5532      && (!currRingIsOverIntegralDomain()))
5533  {
5534    Werror("Bareiss algorithm not defined over coefficient rings %s",
5535           "with zero divisors.");
5536    return TRUE;
5537  }
5538  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
5539  {
5540    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
5541           m->rows(), m->cols());
5542    return TRUE;
5543  }
5544  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
5545      && (noCacheMinors || noCacheMonomials))
5546  {
5547    cacheMinors = 200;
5548    cacheMonomials = 100000;
5549  }
5550
5551  /* here come the actual procedure calls */
5552  if (noAlgorithm)
5553    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
5554                                       (noIdeal ? 0 : IasSB), false);
5555  else if (strcmp(algorithm, "Cache") == 0)
5556    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
5557                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
5558                                   cacheMonomials, false);
5559  else
5560    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
5561                              (noIdeal ? 0 : IasSB), false);
5562  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
5563  res->rtyp = IDEAL_CMD;
5564  return FALSE;
5565}
5566static BOOLEAN jjNEWSTRUCT3(leftv res, leftv u, leftv v, leftv w)
5567{
5568  // u: the name of the new type
5569  // v: the parent type
5570  // w: the elements
5571  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
5572                                            (const char *)w->Data());
5573  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
5574  return d==NULL;
5575}
5576static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
5577{
5578  // handles preimage(r,phi,i) and kernel(r,phi)
5579  idhdl h;
5580  ring rr;
5581  map mapping;
5582  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
5583
5584  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
5585  {
5586    WerrorS("2nd/3rd arguments must have names");
5587    return TRUE;
5588  }
5589  rr=(ring)u->Data();
5590  const char *ring_name=u->Name();
5591  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
5592  {
5593    if (h->typ==MAP_CMD)
5594    {
5595      mapping=IDMAP(h);
5596      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
5597      if ((preim_ring==NULL)
5598      || (IDRING(preim_ring)!=currRing))
5599      {
5600        Werror("preimage ring `%s` is not the basering",mapping->preimage);
5601        return TRUE;
5602      }
5603    }
5604    else if (h->typ==IDEAL_CMD)
5605    {
5606      mapping=IDMAP(h);
5607    }
5608    else
5609    {
5610      Werror("`%s` is no map nor ideal",IDID(h));
5611      return TRUE;
5612    }
5613  }
5614  else
5615  {
5616    Werror("`%s` is not defined in `%s`",v->name,ring_name);
5617    return TRUE;
5618  }
5619  ideal image;
5620  if (kernel_cmd) image=idInit(1,1);
5621  else
5622  {
5623    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
5624    {
5625      if (h->typ==IDEAL_CMD)
5626      {
5627        image=IDIDEAL(h);
5628      }
5629      else
5630      {
5631        Werror("`%s` is no ideal",IDID(h));
5632        return TRUE;
5633      }
5634    }
5635    else
5636    {
5637      Werror("`%s` is not defined in `%s`",w->name,ring_name);
5638      return TRUE;
5639    }
5640  }
5641  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
5642  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
5643  {
5644    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
5645  }
5646  res->data=(char *)maGetPreimage(rr,mapping,image);
5647  if (kernel_cmd) idDelete(&image);
5648  return (res->data==NULL/* is of type ideal, should not be NULL*/);
5649}
5650static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
5651{
5652  int di, k;
5653  int i=(int)(long)u->Data();
5654  int r=(int)(long)v->Data();
5655  int c=(int)(long)w->Data();
5656  if ((r<=0) || (c<=0)) return TRUE;
5657  intvec *iv = new intvec(r, c, 0);
5658  if (iv->rows()==0)
5659  {
5660    delete iv;
5661    return TRUE;
5662  }
5663  if (i!=0)
5664  {
5665    if (i<0) i = -i;
5666    di = 2 * i + 1;
5667    for (k=0; k<iv->length(); k++)
5668    {
5669      (*iv)[k] = ((siRand() % di) - i);
5670    }
5671  }
5672  res->data = (char *)iv;
5673  return FALSE;
5674}
5675static BOOLEAN jjSUBST_Test(leftv v,leftv w,
5676  int &ringvar, poly &monomexpr)
5677{
5678  monomexpr=(poly)w->Data();
5679  poly p=(poly)v->Data();
5680  #if 0
5681  if (pLength(monomexpr)>1)
5682  {
5683    Werror("`%s` substitutes a ringvar only by a term",
5684      Tok2Cmdname(SUBST_CMD));
5685    return TRUE;
5686  }
5687  #endif
5688  if (!(ringvar=pVar(p)))
5689  {
5690    if (rField_is_Extension(currRing))
5691    {
5692      assume(currRing->algring!=NULL);
5693      lnumber n=(lnumber)pGetCoeff(p);
5694      ringvar=-p_Var(n->z,currRing->algring);
5695    }
5696    if(ringvar==0)
5697    {
5698      WerrorS("ringvar/par expected");
5699      return TRUE;
5700    }
5701  }
5702  return FALSE;
5703}
5704static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
5705{
5706  int ringvar;
5707  poly monomexpr;
5708  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
5709  if (nok) return TRUE;
5710  poly p=(poly)u->Data();
5711  if (ringvar>0)
5712  {
5713    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
5714    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
5715    {
5716      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask);
5717      //return TRUE;
5718    }
5719    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
5720      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
5721    else
5722      res->data= pSubstPoly(p,ringvar,monomexpr);
5723  }
5724  else
5725  {
5726    res->data=pSubstPar(p,-ringvar,monomexpr);
5727  }
5728  return FALSE;
5729}
5730static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
5731{
5732  int ringvar;
5733  poly monomexpr;
5734  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
5735  if (nok) return TRUE;
5736  if (ringvar>0)
5737  {
5738    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
5739      res->data = idSubst((ideal)u->CopyD(res->rtyp),ringvar,monomexpr);
5740    else
5741      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
5742  }
5743  else
5744  {
5745    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
5746  }
5747  return FALSE;
5748}
5749// we do not want to have jjSUBST_Id_X inlined:
5750static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
5751                            int input_type);
5752static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
5753{
5754  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
5755}
5756static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
5757{
5758  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
5759}
5760static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
5761{
5762  sleftv tmp;
5763  memset(&tmp,0,sizeof(tmp));
5764  // do not check the result, conversion from int/number to poly works always
5765  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
5766  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
5767  tmp.CleanUp();
5768  return b;
5769}
5770static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
5771{
5772  matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
5773  ideal I=(ideal)u->CopyD(IDEAL_CMD);
5774  int i=si_min(IDELEMS(I),(int)(long)v->Data()*(int)(long)w->Data());
5775  //for(i=i-1;i>=0;i--)
5776  //{
5777  //  m->m[i]=I->m[i];
5778  //  I->m[i]=NULL;
5779  //}
5780  memcpy4(m->m,I->m,i*sizeof(poly));
5781  memset(I->m,0,i*sizeof(poly));
5782  idDelete(&I);
5783  res->data = (char *)m;
5784  return FALSE;
5785}
5786static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
5787{
5788  res->data = (char *)idModule2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
5789           (int)(long)v->Data(),(int)(long)w->Data());
5790  return FALSE;
5791}
5792static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
5793{
5794  matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
5795  matrix I=(matrix)u->CopyD(MATRIX_CMD);
5796  int r=si_min(MATROWS(I),(int)(long)v->Data());
5797  int c=si_min(MATCOLS(I),(int)(long)w->Data());
5798  int i,j;
5799  for(i=r;i>0;i--)
5800  {
5801    for(j=c;j>0;j--)
5802    {
5803      MATELEM(m,i,j)=MATELEM(I,i,j);
5804      MATEL