source: git/Singular/iparith.cc @ e43dc3

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