source: git/Singular/iparith.cc @ c4dab4

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