source: git/Singular/iparith.cc @ 115281

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