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

spielwiese
Last change on this file since 0beffdf was 0beffdf, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix: bb used as function (tr #445)
  • Property mode set to 100644
File size: 216.0 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); ring rCompose(const lists  L);
84
85
86// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
87
88#ifdef HAVE_PLURAL
89  #include <kernel/ratgring.h>
90  #include <kernel/nc.h>
91  #include <polys/nc/nc.h>
92  #include <polys/nc/sca.h>
93  #define ALLOW_PLURAL     1
94  #define NO_PLURAL        0
95  #define COMM_PLURAL      2
96  #define  PLURAL_MASK 3
97#else /* HAVE_PLURAL */
98  #define ALLOW_PLURAL     0
99  #define NO_PLURAL        0
100  #define COMM_PLURAL      0
101  #define  PLURAL_MASK     0
102#endif /* HAVE_PLURAL */
103
104#ifdef HAVE_RINGS
105  #define RING_MASK        4
106  #define ZERODIVISOR_MASK 8
107#else
108  #define RING_MASK        0
109  #define ZERODIVISOR_MASK 0
110#endif
111#define ALLOW_RING       4
112#define NO_RING          0
113#define NO_ZERODIVISOR   8
114#define ALLOW_ZERODIVISOR  0
115
116static BOOLEAN check_valid(const int p, const int op);
117
118/*=============== types =====================*/
119struct sValCmdTab
120{
121  short cmd;
122  short start;
123};
124
125typedef sValCmdTab jjValCmdTab[];
126
127struct _scmdnames
128{
129  char *name;
130  short alias;
131  short tokval;
132  short toktype;
133};
134typedef struct _scmdnames cmdnames;
135
136
137typedef char * (*Proc1)(char *);
138struct sValCmd1
139{
140  proc1 p;
141  short cmd;
142  short res;
143  short arg;
144  short valid_for;
145};
146
147typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
148struct sValCmd2
149{
150  proc2 p;
151  short cmd;
152  short res;
153  short arg1;
154  short arg2;
155  short valid_for;
156};
157
158typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
159struct sValCmd3
160{
161  proc3 p;
162  short cmd;
163  short res;
164  short arg1;
165  short arg2;
166  short arg3;
167  short valid_for;
168};
169struct sValCmdM
170{
171  proc1 p;
172  short cmd;
173  short res;
174  short number_of_args; /* -1: any, -2: any >0, .. */
175  short valid_for;
176};
177
178typedef struct
179{
180  cmdnames *sCmds;             /**< array of existing commands */
181  struct sValCmd1 *psValCmd1;
182  struct sValCmd2 *psValCmd2;
183  struct sValCmd3 *psValCmd3;
184  struct sValCmdM *psValCmdM;
185  int nCmdUsed;      /**< number of commands used */
186  int nCmdAllocated; /**< number of commands-slots allocated */
187  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
188} SArithBase;
189
190/*---------------------------------------------------------------------*
191 * File scope Variables (Variables share by several functions in
192 *                       the same file )
193 *
194 *---------------------------------------------------------------------*/
195static SArithBase sArithBase;  /**< Base entry for arithmetic */
196
197/*---------------------------------------------------------------------*
198 * Extern Functions declarations
199 *
200 *---------------------------------------------------------------------*/
201static int _gentable_sort_cmds(const void *a, const void *b);
202extern int iiArithRemoveCmd(char *szName);
203extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
204                         short nToktype, short nPos=-1);
205
206/*============= proc =======================*/
207static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
208static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
209static Subexpr jjMakeSub(leftv e);
210
211/*============= vars ======================*/
212extern int cmdtok;
213extern BOOLEAN expected_parms;
214
215#define ii_div_by_0 "div. by 0"
216
217int iiOp; /* the current operation*/
218
219/*=================== simple helpers =================*/
220poly pHeadProc(poly p)
221{
222  return pHead(p);
223}
224
225int iiTokType(int op)
226{
227  for (int i=0;i<sArithBase.nCmdUsed;i++)
228  {
229    if (sArithBase.sCmds[i].tokval==op)
230      return sArithBase.sCmds[i].toktype;
231  }
232  return 0;
233}
234
235/*=================== operations with 2 args.: static proc =================*/
236/* must be ordered: first operations for chars (infix ops),
237 * then alphabetically */
238
239static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
240{
241  bigintmat* aa= (bigintmat *)u->Data();
242  int bb = (int)(long)(v->Data());
243  if (errorreported) return TRUE;
244  bigintmat *cc=NULL;
245  switch (iiOp)
246  {
247    case '+': cc=bimAdd(aa,bb); break;
248    case '-': cc=bimSub(aa,bb); break;
249    case '*': cc=bimMult(aa,bb); break;
250  }
251  res->data=(char *)cc;
252  return cc==NULL;
253}
254static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
255{
256  return jjOP_BIM_I(res, v, u);
257}
258static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
259{
260  bigintmat* aa= (bigintmat *)u->Data();
261  number bb = (number)(v->Data());
262  if (errorreported) return TRUE;
263  bigintmat *cc=NULL;
264  switch (iiOp)
265  {
266    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
267  }
268  res->data=(char *)cc;
269  return cc==NULL;
270}
271static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
272{
273  return jjOP_BIM_BI(res, v, u);
274}
275static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
276{
277  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
278  int bb = (int)(long)(v->Data());
279  if (errorreported) return TRUE;
280  switch (iiOp)
281  {
282    case '+': (*aa) += bb; break;
283    case '-': (*aa) -= bb; break;
284    case '*': (*aa) *= bb; break;
285    case '/':
286    case INTDIV_CMD: (*aa) /= bb; break;
287    case '%': (*aa) %= bb; break;
288  }
289  res->data=(char *)aa;
290  return FALSE;
291}
292static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
293{
294  return jjOP_IV_I(res,v,u);
295}
296static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
297{
298  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
299  int bb = (int)(long)(v->Data());
300  int i=si_min(aa->rows(),aa->cols());
301  switch (iiOp)
302  {
303    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
304              break;
305    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
306              break;
307  }
308  res->data=(char *)aa;
309  return FALSE;
310}
311static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
312{
313  return jjOP_IM_I(res,v,u);
314}
315static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
316{
317  int l=(int)(long)v->Data();
318  if (l>0)
319  {
320    int d=(int)(long)u->Data();
321    intvec *vv=new intvec(l);
322    int i;
323    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
324    res->data=(char *)vv;
325  }
326  return (l<=0);
327}
328static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
329{
330  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
331  return FALSE;
332}
333static void jjEQUAL_REST(leftv res,leftv u,leftv v);
334static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
335{
336  intvec*    a = (intvec * )(u->Data());
337  intvec*    b = (intvec * )(v->Data());
338  int r=a->compare(b);
339  switch  (iiOp)
340  {
341    case '<':
342      res->data  = (char *) (r<0);
343      break;
344    case '>':
345      res->data  = (char *) (r>0);
346      break;
347    case LE:
348      res->data  = (char *) (r<=0);
349      break;
350    case GE:
351      res->data  = (char *) (r>=0);
352      break;
353    case EQUAL_EQUAL:
354    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
355      res->data  = (char *) (r==0);
356      break;
357  }
358  jjEQUAL_REST(res,u,v);
359  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
360  return FALSE;
361}
362static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
363{
364  bigintmat*    a = (bigintmat * )(u->Data());
365  bigintmat*    b = (bigintmat * )(v->Data());
366  int r=a->compare(b);
367  switch  (iiOp)
368  {
369    case '<':
370      res->data  = (char *) (r<0);
371      break;
372    case '>':
373      res->data  = (char *) (r>0);
374      break;
375    case LE:
376      res->data  = (char *) (r<=0);
377      break;
378    case GE:
379      res->data  = (char *) (r>=0);
380      break;
381    case EQUAL_EQUAL:
382    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
383      res->data  = (char *) (r==0);
384      break;
385  }
386  jjEQUAL_REST(res,u,v);
387  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
388  return FALSE;
389}
390static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
391{
392  intvec* a = (intvec * )(u->Data());
393  int     b = (int)(long)(v->Data());
394  int r=a->compare(b);
395  switch  (iiOp)
396  {
397    case '<':
398      res->data  = (char *) (r<0);
399      break;
400    case '>':
401      res->data  = (char *) (r>0);
402      break;
403    case LE:
404      res->data  = (char *) (r<=0);
405      break;
406    case GE:
407      res->data  = (char *) (r>=0);
408      break;
409    case EQUAL_EQUAL:
410    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
411      res->data  = (char *) (r==0);
412      break;
413  }
414  jjEQUAL_REST(res,u,v);
415  return FALSE;
416}
417static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
418{
419  poly p=(poly)u->Data();
420  poly q=(poly)v->Data();
421  int r=pCmp(p,q);
422  if (r==0)
423  {
424    number h=nSub(pGetCoeff(p),pGetCoeff(q));
425    /* compare lead coeffs */
426    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
427    nDelete(&h);
428  }
429  else if (p==NULL)
430  {
431    if (q==NULL)
432    {
433      /* compare 0, 0 */
434      r=0;
435    }
436    else if(pIsConstant(q))
437    {
438      /* compare 0, const */
439      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
440    }
441  }
442  else if (q==NULL)
443  {
444    if (pIsConstant(p))
445    {
446      /* compare const, 0 */
447      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
448    }
449  }
450  switch  (iiOp)
451  {
452    case '<':
453      res->data  = (char *) (r < 0);
454      break;
455    case '>':
456      res->data  = (char *) (r > 0);
457      break;
458    case LE:
459      res->data  = (char *) (r <= 0);
460      break;
461    case GE:
462      res->data  = (char *) (r >= 0);
463      break;
464    //case EQUAL_EQUAL:
465    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
466    //  res->data  = (char *) (r == 0);
467    //  break;
468  }
469  jjEQUAL_REST(res,u,v);
470  return FALSE;
471}
472static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
473{
474  char*    a = (char * )(u->Data());
475  char*    b = (char * )(v->Data());
476  int result = strcmp(a,b);
477  switch  (iiOp)
478  {
479    case '<':
480      res->data  = (char *) (result  < 0);
481      break;
482    case '>':
483      res->data  = (char *) (result  > 0);
484      break;
485    case LE:
486      res->data  = (char *) (result  <= 0);
487      break;
488    case GE:
489      res->data  = (char *) (result  >= 0);
490      break;
491    case EQUAL_EQUAL:
492    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
493      res->data  = (char *) (result  == 0);
494      break;
495  }
496  jjEQUAL_REST(res,u,v);
497  return FALSE;
498}
499static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
500{
501  if (u->Next()!=NULL)
502  {
503    u=u->next;
504    res->next = (leftv)omAllocBin(sleftv_bin);
505    return iiExprArith2(res->next,u,iiOp,v);
506  }
507  else if (v->Next()!=NULL)
508  {
509    v=v->next;
510    res->next = (leftv)omAllocBin(sleftv_bin);
511    return iiExprArith2(res->next,u,iiOp,v);
512  }
513  return FALSE;
514}
515static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
516{
517  int b=(int)(long)u->Data();
518  int e=(int)(long)v->Data();
519  int rc = 1;
520  BOOLEAN overflow=FALSE;
521  if (e >= 0)
522  {
523    if (b==0)
524    {
525      rc=(e==0);
526    }
527    else
528    {
529      int oldrc;
530      while ((e--)!=0)
531      {
532        oldrc=rc;
533        rc *= b;
534        if (!overflow)
535        {
536          if(rc/b!=oldrc) overflow=TRUE;
537        }
538      }
539      if (overflow)
540        WarnS("int overflow(^), result may be wrong");
541    }
542    res->data = (char *)((long)rc);
543    if (u!=NULL) return jjOP_REST(res,u,v);
544    return FALSE;
545  }
546  else
547  {
548    WerrorS("exponent must be non-negative");
549    return TRUE;
550  }
551}
552static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
553{
554  int e=(int)(long)v->Data();
555  number n=(number)u->Data();
556  if (e>=0)
557  {
558    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
559  }
560  else
561  {
562    WerrorS("exponent must be non-negative");
563    return TRUE;
564  }
565  if (u!=NULL) return jjOP_REST(res,u,v);
566  return FALSE;
567}
568static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
569{
570  int e=(int)(long)v->Data();
571  number n=(number)u->Data();
572  int d=0;
573  if (e<0)
574  {
575    n=nInvers(n);
576    e=-e;
577    d=1;
578  }
579  nPower(n,e,(number*)&res->data);
580  if (d) nDelete(&n);
581  if (u!=NULL) return jjOP_REST(res,u,v);
582  return FALSE;
583}
584static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
585{
586  int v_i=(int)(long)v->Data();
587  if (v_i<0)
588  {
589    WerrorS("exponent must be non-negative");
590    return TRUE;
591  }
592  poly u_p=(poly)u->CopyD(POLY_CMD);
593  if ((u_p!=NULL)
594  && ((v_i!=0) &&
595      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i)))
596  {
597    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
598                                    pTotaldegree(u_p),v_i,currRing->bitmask);
599    pDelete(&u_p);
600    return TRUE;
601  }
602  res->data = (char *)pPower(u_p,v_i);
603  if (u!=NULL) return jjOP_REST(res,u,v);
604  return errorreported; /* pPower may set errorreported via Werror */
605}
606static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
607{
608  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
609  if (u!=NULL) return jjOP_REST(res,u,v);
610  return FALSE;
611}
612static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
613{
614  u=u->next;
615  v=v->next;
616  if (u==NULL)
617  {
618    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
619    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
620    {
621      do
622      {
623        if (res->next==NULL)
624          res->next = (leftv)omAlloc0Bin(sleftv_bin);
625        leftv tmp_v=v->next;
626        v->next=NULL;
627        BOOLEAN b=iiExprArith1(res->next,v,'-');
628        v->next=tmp_v;
629        if (b)
630          return TRUE;
631        v=tmp_v;
632        res=res->next;
633      } while (v!=NULL);
634      return FALSE;
635    }
636    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
637    {
638      res->next = (leftv)omAlloc0Bin(sleftv_bin);
639      res=res->next;
640      res->data = v->CopyD();
641      res->rtyp = v->Typ();
642      v=v->next;
643      if (v==NULL) return FALSE;
644    }
645  }
646  if (v!=NULL)                     /* u<>NULL, v<>NULL */
647  {
648    do
649    {
650      res->next = (leftv)omAlloc0Bin(sleftv_bin);
651      leftv tmp_u=u->next; u->next=NULL;
652      leftv tmp_v=v->next; v->next=NULL;
653      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
654      u->next=tmp_u;
655      v->next=tmp_v;
656      if (b)
657        return TRUE;
658      u=tmp_u;
659      v=tmp_v;
660      res=res->next;
661    } while ((u!=NULL) && (v!=NULL));
662    return FALSE;
663  }
664  loop                             /* u<>NULL, v==NULL */
665  {
666    res->next = (leftv)omAlloc0Bin(sleftv_bin);
667    res=res->next;
668    res->data = u->CopyD();
669    res->rtyp = u->Typ();
670    u=u->next;
671    if (u==NULL) return FALSE;
672  }
673}
674static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
675{
676  idhdl packhdl;
677  switch(u->Typ())
678  {
679      case 0:
680        Print("%s of type 'ANY'. Trying load.\n", v->name);
681        if(iiTryLoadLib(u, u->name))
682        {
683          Werror("'%s' no such package", u->name);
684          return TRUE;
685        }
686        syMake(u,u->name,NULL);
687        // else: use next case !!! no break !!!
688      case PACKAGE_CMD:
689        packhdl = (idhdl)u->data;
690        if((!IDPACKAGE(packhdl)->loaded)
691        && (IDPACKAGE(packhdl)->language > LANG_TOP))
692        {
693          Werror("'%s' not loaded", u->name);
694          return TRUE;
695        }
696        if(v->rtyp == IDHDL)
697        {
698          v->name = omStrDup(v->name);
699        }
700        v->req_packhdl=IDPACKAGE(packhdl);
701        syMake(v, v->name, packhdl);
702        memcpy(res, v, sizeof(sleftv));
703        memset(v, 0, sizeof(sleftv));
704        break;
705      case DEF_CMD:
706        break;
707      default:
708        WerrorS("<package>::<id> expected");
709        return TRUE;
710  }
711  return FALSE;
712}
713static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
714{
715  unsigned int a=(unsigned int)(unsigned long)u->Data();
716  unsigned int b=(unsigned int)(unsigned long)v->Data();
717  unsigned int c=a+b;
718  res->data = (char *)((long)c);
719  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
720  {
721    WarnS("int overflow(+), result may be wrong");
722  }
723  return jjPLUSMINUS_Gen(res,u,v);
724}
725static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
726{
727  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
728  return jjPLUSMINUS_Gen(res,u,v);
729}
730static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
731{
732  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
733  return jjPLUSMINUS_Gen(res,u,v);
734}
735static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
736{
737  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
738  return jjPLUSMINUS_Gen(res,u,v);
739}
740static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
741{
742  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
743  if (res->data==NULL)
744  {
745     WerrorS("intmat size not compatible");
746     return TRUE;
747  }
748  return jjPLUSMINUS_Gen(res,u,v);
749}
750static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
751{
752  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
753  if (res->data==NULL)
754  {
755    WerrorS("bigintmat size not compatible");
756    return TRUE;
757  }
758  return jjPLUSMINUS_Gen(res,u,v);
759}
760static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
761{
762  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
763  res->data = (char *)(mp_Add(A , B, currRing));
764  if (res->data==NULL)
765  {
766     Werror("matrix size not compatible(%dx%d, %dx%d)",
767             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
768     return TRUE;
769  }
770  return jjPLUSMINUS_Gen(res,u,v);
771}
772static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
773{
774  matrix m=(matrix)u->Data();
775  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
776  if (iiOp=='+')
777    res->data = (char *)mp_Add(m , p,currRing);
778  else
779    res->data = (char *)mp_Sub(m , p,currRing);
780  idDelete((ideal *)&p);
781  return jjPLUSMINUS_Gen(res,u,v);
782}
783static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
784{
785  return jjPLUS_MA_P(res,v,u);
786}
787static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
788{
789  char*    a = (char * )(u->Data());
790  char*    b = (char * )(v->Data());
791  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
792  strcpy(r,a);
793  strcat(r,b);
794  res->data=r;
795  return jjPLUSMINUS_Gen(res,u,v);
796}
797static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
798{
799  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
800  return jjPLUSMINUS_Gen(res,u,v);
801}
802static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
803{
804  void *ap=u->Data(); void *bp=v->Data();
805  int aa=(int)(long)ap;
806  int bb=(int)(long)bp;
807  int cc=aa-bb;
808  unsigned int a=(unsigned int)(unsigned long)ap;
809  unsigned int b=(unsigned int)(unsigned long)bp;
810  unsigned int c=a-b;
811  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
812  {
813    WarnS("int overflow(-), result may be wrong");
814  }
815  res->data = (char *)((long)cc);
816  return jjPLUSMINUS_Gen(res,u,v);
817}
818static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
819{
820  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
821  return jjPLUSMINUS_Gen(res,u,v);
822}
823static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
824{
825  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
826  return jjPLUSMINUS_Gen(res,u,v);
827}
828static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
829{
830  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
831  return jjPLUSMINUS_Gen(res,u,v);
832}
833static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
834{
835  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
836  if (res->data==NULL)
837  {
838     WerrorS("intmat size not compatible");
839     return TRUE;
840  }
841  return jjPLUSMINUS_Gen(res,u,v);
842}
843static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
844{
845  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
846  if (res->data==NULL)
847  {
848    WerrorS("bigintmat size not compatible");
849    return TRUE;
850  }
851  return jjPLUSMINUS_Gen(res,u,v);
852}
853static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
854{
855  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
856  res->data = (char *)(mp_Sub(A , B, currRing));
857  if (res->data==NULL)
858  {
859     Werror("matrix size not compatible(%dx%d, %dx%d)",
860             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
861     return TRUE;
862  }
863  return jjPLUSMINUS_Gen(res,u,v);
864  return FALSE;
865}
866static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
867{
868  int a=(int)(long)u->Data();
869  int b=(int)(long)v->Data();
870  int c=a * b;
871  if ((b!=0) && (c/b !=a))
872    WarnS("int overflow(*), result may be wrong");
873  res->data = (char *)((long)c);
874  if ((u->Next()!=NULL) || (v->Next()!=NULL))
875    return jjOP_REST(res,u,v);
876  return FALSE;
877}
878static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
879{
880  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
881  if ((v->next!=NULL) || (u->next!=NULL))
882    return jjOP_REST(res,u,v);
883  return FALSE;
884}
885static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
886{
887  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
888  number n=(number)res->data;
889  nNormalize(n);
890  res->data=(char *)n;
891  if ((v->next!=NULL) || (u->next!=NULL))
892    return jjOP_REST(res,u,v);
893  return FALSE;
894}
895static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
896{
897  poly a;
898  poly b;
899  if (v->next==NULL)
900  {
901    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
902    if (u->next==NULL)
903    {
904      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
905      if ((a!=NULL) && (b!=NULL)
906      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask)-(long)pTotaldegree(b)))
907      {
908        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
909          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
910        pDelete(&a);
911        pDelete(&b);
912        return TRUE;
913      }
914      res->data = (char *)(pMult( a, b));
915      pNormalize((poly)res->data);
916      return FALSE;
917    }
918    // u->next exists: copy v
919    b=pCopy((poly)v->Data());
920    if ((a!=NULL) && (b!=NULL)
921    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
922    {
923      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
924          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
925      pDelete(&a);
926      pDelete(&b);
927      return TRUE;
928    }
929    res->data = (char *)(pMult( a, b));
930    pNormalize((poly)res->data);
931    return jjOP_REST(res,u,v);
932  }
933  // v->next exists: copy u
934  a=pCopy((poly)u->Data());
935  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
936  if ((a!=NULL) && (b!=NULL)
937  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
938  {
939    pDelete(&a);
940    pDelete(&b);
941    WerrorS("OVERFLOW");
942    return TRUE;
943  }
944  res->data = (char *)(pMult( a, b));
945  pNormalize((poly)res->data);
946  return jjOP_REST(res,u,v);
947}
948static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
949{
950  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
951  id_Normalize((ideal)res->data,currRing);
952  if ((v->next!=NULL) || (u->next!=NULL))
953    return jjOP_REST(res,u,v);
954  return FALSE;
955}
956static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
957{
958  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
959  if (res->data==NULL)
960  {
961     WerrorS("intmat size not compatible");
962     return TRUE;
963  }
964  if ((v->next!=NULL) || (u->next!=NULL))
965    return jjOP_REST(res,u,v);
966  return FALSE;
967}
968static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
969{
970  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
971  if (res->data==NULL)
972  {
973    WerrorS("bigintmat size not compatible");
974    return TRUE;
975  }
976  if ((v->next!=NULL) || (u->next!=NULL))
977    return jjOP_REST(res,u,v);
978  return FALSE;
979}
980static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
981{
982  number n=n_Init_bigint((number)v->Data(),coeffs_BIGINT,currRing->cf);
983  poly p=pNSet(n);
984  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
985  res->data = (char *)I;
986  return FALSE;
987}
988static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
989{
990  return jjTIMES_MA_BI1(res,v,u);
991}
992static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
993{
994  poly p=(poly)v->CopyD(POLY_CMD);
995  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
996  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
997  if (r>0) I->rank=r;
998  id_Normalize(I,currRing);
999  res->data = (char *)I;
1000  return FALSE;
1001}
1002static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1003{
1004  poly p=(poly)u->CopyD(POLY_CMD);
1005  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1006  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1007  if (r>0) I->rank=r;
1008  id_Normalize(I,currRing);
1009  res->data = (char *)I;
1010  return FALSE;
1011}
1012static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1013{
1014  number n=(number)v->CopyD(NUMBER_CMD);
1015  poly p=pNSet(n);
1016  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1017  id_Normalize((ideal)res->data,currRing);
1018  return FALSE;
1019}
1020static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1021{
1022  return jjTIMES_MA_N1(res,v,u);
1023}
1024static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1025{
1026  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1027  id_Normalize((ideal)res->data,currRing);
1028  return FALSE;
1029}
1030static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1031{
1032  return jjTIMES_MA_I1(res,v,u);
1033}
1034static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1035{
1036  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1037  res->data = (char *)mp_Mult(A,B,currRing);
1038  if (res->data==NULL)
1039  {
1040     Werror("matrix size not compatible(%dx%d, %dx%d)",
1041             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1042     return TRUE;
1043  }
1044  id_Normalize((ideal)res->data,currRing);
1045  if ((v->next!=NULL) || (u->next!=NULL))
1046    return jjOP_REST(res,u,v);
1047  return FALSE;
1048}
1049static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1050{
1051  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1052  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1053  n_Delete(&h,coeffs_BIGINT);
1054  return FALSE;
1055}
1056static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1057{
1058  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1059  return FALSE;
1060}
1061static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1062{
1063  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1064                       || nEqual((number)u->Data(),(number)v->Data()));
1065  return FALSE;
1066}
1067static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1068{
1069  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1070  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1071  n_Delete(&h,coeffs_BIGINT);
1072  return FALSE;
1073}
1074static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1075{
1076  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1077  return FALSE;
1078}
1079static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1080{
1081  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1082  return FALSE;
1083}
1084static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1085{
1086  return jjGE_BI(res,v,u);
1087}
1088static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1089{
1090  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1091  return FALSE;
1092}
1093static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1094{
1095  return jjGE_N(res,v,u);
1096}
1097static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1098{
1099  return jjGT_BI(res,v,u);
1100}
1101static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1102{
1103  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1104  return FALSE;
1105}
1106static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1107{
1108  return jjGT_N(res,v,u);
1109}
1110static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1111{
1112  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1113  int a= (int)(long)u->Data();
1114  int b= (int)(long)v->Data();
1115  if (b==0)
1116  {
1117    WerrorS(ii_div_by_0);
1118    return TRUE;
1119  }
1120  int c=a%b;
1121  int r=0;
1122  switch (iiOp)
1123  {
1124    case '%':
1125        r=c;            break;
1126    case '/':
1127    case INTDIV_CMD:
1128        r=((a-c) /b);   break;
1129  }
1130  res->data=(void *)((long)r);
1131  return FALSE;
1132}
1133static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1134{
1135  number q=(number)v->Data();
1136  if (n_IsZero(q,coeffs_BIGINT))
1137  {
1138    WerrorS(ii_div_by_0);
1139    return TRUE;
1140  }
1141  q = n_IntDiv((number)u->Data(),q,coeffs_BIGINT);
1142  n_Normalize(q,coeffs_BIGINT);
1143  res->data = (char *)q;
1144  return FALSE;
1145}
1146static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1147{
1148  number q=(number)v->Data();
1149  if (nIsZero(q))
1150  {
1151    WerrorS(ii_div_by_0);
1152    return TRUE;
1153  }
1154  q = nDiv((number)u->Data(),q);
1155  nNormalize(q);
1156  res->data = (char *)q;
1157  return FALSE;
1158}
1159static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1160{
1161  poly q=(poly)v->Data();
1162  if (q==NULL)
1163  {
1164    WerrorS(ii_div_by_0);
1165    return TRUE;
1166  }
1167  poly p=(poly)(u->Data());
1168  if (p==NULL)
1169  {
1170    res->data=NULL;
1171    return FALSE;
1172  }
1173  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1174  { /* This means that q != 0 consists of at least two terms.
1175       Moreover, currRing is over a field. */
1176#ifdef HAVE_FACTORY
1177    if(pGetComp(p)==0)
1178    {
1179      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1180                                         q /*(poly)(v->Data())*/ ,currRing));
1181    }
1182    else
1183    {
1184      int comps=pMaxComp(p);
1185      ideal I=idInit(comps,1);
1186      p=pCopy(p);
1187      poly h;
1188      int i;
1189      // conversion to a list of polys:
1190      while (p!=NULL)
1191      {
1192        i=pGetComp(p)-1;
1193        h=pNext(p);
1194        pNext(p)=NULL;
1195        pSetComp(p,0);
1196        I->m[i]=pAdd(I->m[i],p);
1197        p=h;
1198      }
1199      // division and conversion to vector:
1200      h=NULL;
1201      p=NULL;
1202      for(i=comps-1;i>=0;i--)
1203      {
1204        if (I->m[i]!=NULL)
1205        {
1206          h=singclap_pdivide(I->m[i],q,currRing);
1207          pSetCompP(h,i+1);
1208          p=pAdd(p,h);
1209        }
1210      }
1211      idDelete(&I);
1212      res->data=(void *)p;
1213    }
1214#else /* HAVE_FACTORY */
1215    WerrorS("division only by a monomial");
1216    return TRUE;
1217#endif /* HAVE_FACTORY */
1218  }
1219  else
1220  { /* This means that q != 0 consists of just one term,
1221       or that currRing is over a coefficient ring. */
1222#ifdef HAVE_RINGS
1223    if (!rField_is_Domain(currRing))
1224    {
1225      WerrorS("division only defined over coefficient domains");
1226      return TRUE;
1227    }
1228    if (pNext(q)!=NULL)
1229    {
1230      WerrorS("division over a coefficient domain only implemented for terms");
1231      return TRUE;
1232    }
1233#endif
1234    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1235  }
1236  pNormalize((poly)res->data);
1237  return FALSE;
1238}
1239static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1240{
1241  poly q=(poly)v->Data();
1242  if (q==NULL)
1243  {
1244    WerrorS(ii_div_by_0);
1245    return TRUE;
1246  }
1247  matrix m=(matrix)(u->Data());
1248  int r=m->rows();
1249  int c=m->cols();
1250  matrix mm=mpNew(r,c);
1251  int i,j;
1252  for(i=r;i>0;i--)
1253  {
1254    for(j=c;j>0;j--)
1255    {
1256      if (pNext(q)!=NULL)
1257      {
1258      #ifdef HAVE_FACTORY
1259        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1260                                           q /*(poly)(v->Data())*/, currRing );
1261#else /* HAVE_FACTORY */
1262        WerrorS("division only by a monomial");
1263        return TRUE;
1264#endif /* HAVE_FACTORY */
1265      }
1266      else
1267        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1268    }
1269  }
1270  id_Normalize((ideal)mm,currRing);
1271  res->data=(char *)mm;
1272  return FALSE;
1273}
1274static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1275{
1276  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1277  jjEQUAL_REST(res,u,v);
1278  return FALSE;
1279}
1280static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1281{
1282  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1283  jjEQUAL_REST(res,u,v);
1284  return FALSE;
1285}
1286static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1287{
1288  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1289  jjEQUAL_REST(res,u,v);
1290  return FALSE;
1291}
1292static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1293{
1294  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1295  jjEQUAL_REST(res,u,v);
1296  return FALSE;
1297}
1298static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1299{
1300  poly p=(poly)u->Data();
1301  poly q=(poly)v->Data();
1302  res->data = (char *) ((long)pEqualPolys(p,q));
1303  jjEQUAL_REST(res,u,v);
1304  return FALSE;
1305}
1306static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1307{
1308  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1309  {
1310    int save_iiOp=iiOp;
1311    if (iiOp==NOTEQUAL)
1312      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1313    else
1314      iiExprArith2(res,u->next,iiOp,v->next);
1315    iiOp=save_iiOp;
1316  }
1317  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1318}
1319static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1320{
1321  res->data = (char *)((long)u->Data() && (long)v->Data());
1322  return FALSE;
1323}
1324static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1325{
1326  res->data = (char *)((long)u->Data() || (long)v->Data());
1327  return FALSE;
1328}
1329static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1330{
1331  res->rtyp=u->rtyp; u->rtyp=0;
1332  res->data=u->data; u->data=NULL;
1333  res->name=u->name; u->name=NULL;
1334  res->e=u->e;       u->e=NULL;
1335  if (res->e==NULL) res->e=jjMakeSub(v);
1336  else
1337  {
1338    Subexpr sh=res->e;
1339    while (sh->next != NULL) sh=sh->next;
1340    sh->next=jjMakeSub(v);
1341  }
1342  return FALSE;
1343}
1344static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1345{
1346  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1347  {
1348    WerrorS("indexed object must have a name");
1349    return TRUE;
1350  }
1351  intvec * iv=(intvec *)v->Data();
1352  leftv p=NULL;
1353  int i;
1354  sleftv t;
1355  memset(&t,0,sizeof(t));
1356  t.rtyp=INT_CMD;
1357  for (i=0;i<iv->length(); i++)
1358  {
1359    t.data=(char *)((long)(*iv)[i]);
1360    if (p==NULL)
1361    {
1362      p=res;
1363    }
1364    else
1365    {
1366      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1367      p=p->next;
1368    }
1369    p->rtyp=IDHDL;
1370    p->data=u->data;
1371    p->name=u->name;
1372    p->flag=u->flag;
1373    p->e=jjMakeSub(&t);
1374  }
1375  u->rtyp=0;
1376  u->data=NULL;
1377  u->name=NULL;
1378  return FALSE;
1379}
1380static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1381{
1382  poly p=(poly)u->Data();
1383  int i=(int)(long)v->Data();
1384  int j=0;
1385  while (p!=NULL)
1386  {
1387    j++;
1388    if (j==i)
1389    {
1390      res->data=(char *)pHead(p);
1391      return FALSE;
1392    }
1393    pIter(p);
1394  }
1395  return FALSE;
1396}
1397static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1398{
1399  poly p=(poly)u->Data();
1400  poly r=NULL;
1401  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1402  int i;
1403  int sum=0;
1404  for(i=iv->length()-1;i>=0;i--)
1405    sum+=(*iv)[i];
1406  int j=0;
1407  while ((p!=NULL) && (sum>0))
1408  {
1409    j++;
1410    for(i=iv->length()-1;i>=0;i--)
1411    {
1412      if (j==(*iv)[i])
1413      {
1414        r=pAdd(r,pHead(p));
1415        sum-=j;
1416        (*iv)[i]=0;
1417        break;
1418      }
1419    }
1420    pIter(p);
1421  }
1422  delete iv;
1423  res->data=(char *)r;
1424  return FALSE;
1425}
1426static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1427{
1428  poly p=(poly)u->CopyD(VECTOR_CMD);
1429  poly r=p; // pointer to the beginning of component i
1430  poly o=NULL;
1431  unsigned i=(unsigned)(long)v->Data();
1432  while (p!=NULL)
1433  {
1434    if (pGetComp(p)!=i)
1435    {
1436      if (r==p) r=pNext(p);
1437      if (o!=NULL)
1438      {
1439        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1440        p=pNext(o);
1441      }
1442      else
1443        pLmDelete(&p);
1444    }
1445    else
1446    {
1447      pSetComp(p, 0);
1448      p_SetmComp(p, currRing);
1449      o=p;
1450      p=pNext(o);
1451    }
1452  }
1453  res->data=(char *)r;
1454  return FALSE;
1455}
1456static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1457{
1458  poly p=(poly)u->CopyD(VECTOR_CMD);
1459  if (p!=NULL)
1460  {
1461    poly r=pOne();
1462    poly hp=r;
1463    intvec *iv=(intvec *)v->Data();
1464    int i;
1465    loop
1466    {
1467      for(i=0;i<iv->length();i++)
1468      {
1469        if (((int)pGetComp(p))==(*iv)[i])
1470        {
1471          poly h;
1472          pSplit(p,&h);
1473          pNext(hp)=p;
1474          p=h;
1475          pIter(hp);
1476          break;
1477        }
1478      }
1479      if (p==NULL) break;
1480      if (i==iv->length())
1481      {
1482        pLmDelete(&p);
1483        if (p==NULL) break;
1484      }
1485    }
1486    pLmDelete(&r);
1487    res->data=(char *)r;
1488  }
1489  return FALSE;
1490}
1491static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1492static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1493{
1494  if(u->name==NULL) return TRUE;
1495  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1496  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1497  omFree((ADDRESS)u->name);
1498  u->name=NULL;
1499  char *n=omStrDup(nn);
1500  omFree((ADDRESS)nn);
1501  syMake(res,n);
1502  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1503  return FALSE;
1504}
1505static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1506{
1507  intvec * iv=(intvec *)v->Data();
1508  leftv p=NULL;
1509  int i;
1510  long slen = strlen(u->name) + 14;
1511  char *n = (char*) omAlloc(slen);
1512
1513  for (i=0;i<iv->length(); i++)
1514  {
1515    if (p==NULL)
1516    {
1517      p=res;
1518    }
1519    else
1520    {
1521      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1522      p=p->next;
1523    }
1524    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1525    syMake(p,omStrDup(n));
1526  }
1527  omFree((ADDRESS)u->name);
1528  u->name = NULL;
1529  omFreeSize(n, slen);
1530  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1531  return FALSE;
1532}
1533static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1534{
1535  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1536  memset(tmp,0,sizeof(sleftv));
1537  BOOLEAN b;
1538  if (v->Typ()==INTVEC_CMD)
1539    b=jjKLAMMER_IV(tmp,u,v);
1540  else
1541    b=jjKLAMMER(tmp,u,v);
1542  if (b)
1543  {
1544    omFreeBin(tmp,sleftv_bin);
1545    return TRUE;
1546  }
1547  leftv h=res;
1548  while (h->next!=NULL) h=h->next;
1549  h->next=tmp;
1550  return FALSE;
1551}
1552BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1553{
1554  void *d;
1555  Subexpr e;
1556  int typ;
1557  BOOLEAN t=FALSE;
1558  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1559  {
1560    idrec tmp_proc;
1561    tmp_proc.id="_auto";
1562    tmp_proc.typ=PROC_CMD;
1563    tmp_proc.data.pinf=(procinfo *)u->Data();
1564    tmp_proc.ref=1;
1565    d=u->data; u->data=(void *)&tmp_proc;
1566    e=u->e; u->e=NULL;
1567    t=TRUE;
1568    typ=u->rtyp; u->rtyp=IDHDL;
1569  }
1570  leftv sl;
1571  if (u->req_packhdl==currPack)
1572    sl = iiMake_proc((idhdl)u->data,NULL,v);
1573  else
1574    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1575  if (t)
1576  {
1577    u->rtyp=typ;
1578    u->data=d;
1579    u->e=e;
1580  }
1581  if (sl==NULL)
1582  {
1583    return TRUE;
1584  }
1585  else
1586  {
1587    memcpy(res,sl,sizeof(sleftv));
1588  }
1589  return FALSE;
1590}
1591static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1592{
1593  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1594  leftv sl=NULL;
1595  if ((v->e==NULL)&&(v->name!=NULL))
1596  {
1597    map m=(map)u->Data();
1598    sl=iiMap(m,v->name);
1599  }
1600  else
1601  {
1602    Werror("%s(<name>) expected",u->Name());
1603  }
1604  if (sl==NULL) return TRUE;
1605  memcpy(res,sl,sizeof(sleftv));
1606  omFreeBin((ADDRESS)sl, sleftv_bin);
1607  return FALSE;
1608}
1609#ifdef HAVE_FACTORY
1610static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1611{
1612  intvec *c=(intvec*)u->Data();
1613  intvec* p=(intvec*)v->Data();
1614  int rl=p->length();
1615  number *x=(number *)omAlloc(rl*sizeof(number));
1616  number *q=(number *)omAlloc(rl*sizeof(number));
1617  int i;
1618  for(i=rl-1;i>=0;i--)
1619  {
1620    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1621    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1622  }
1623  number n=n_ChineseRemainder(x,q,rl,coeffs_BIGINT);
1624  for(i=rl-1;i>=0;i--)
1625  {
1626    n_Delete(&(q[i]),coeffs_BIGINT);
1627    n_Delete(&(x[i]),coeffs_BIGINT);
1628  }
1629  omFree(x); omFree(q);
1630  res->data=(char *)n;
1631  return FALSE;
1632}
1633#endif
1634#if 0
1635static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1636{
1637  lists c=(lists)u->CopyD(); // list of poly
1638  intvec* p=(intvec*)v->Data();
1639  int rl=p->length();
1640  poly r=NULL,h, result=NULL;
1641  number *x=(number *)omAlloc(rl*sizeof(number));
1642  number *q=(number *)omAlloc(rl*sizeof(number));
1643  int i;
1644  for(i=rl-1;i>=0;i--)
1645  {
1646    q[i]=nlInit((*p)[i]);
1647  }
1648  loop
1649  {
1650    for(i=rl-1;i>=0;i--)
1651    {
1652      if (c->m[i].Typ()!=POLY_CMD)
1653      {
1654        Werror("poly expected at pos %d",i+1);
1655        for(i=rl-1;i>=0;i--)
1656        {
1657          nlDelete(&(q[i]),currRing);
1658        }
1659        omFree(x); omFree(q); // delete c
1660        return TRUE;
1661      }
1662      h=((poly)c->m[i].Data());
1663      if (r==NULL) r=h;
1664      else if (pLmCmp(r,h)==-1) r=h;
1665    }
1666    if (r==NULL) break;
1667    for(i=rl-1;i>=0;i--)
1668    {
1669      h=((poly)c->m[i].Data());
1670      if (pLmCmp(r,h)==0)
1671      {
1672        x[i]=pGetCoeff(h);
1673        h=pLmFreeAndNext(h);
1674        c->m[i].data=(char*)h;
1675      }
1676      else
1677        x[i]=nlInit(0);
1678    }
1679    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1680    for(i=rl-1;i>=0;i--)
1681    {
1682      nlDelete(&(x[i]),currRing);
1683    }
1684    h=pHead(r);
1685    pSetCoeff(h,n);
1686    result=pAdd(result,h);
1687  }
1688  for(i=rl-1;i>=0;i--)
1689  {
1690    nlDelete(&(q[i]),currRing);
1691  }
1692  omFree(x); omFree(q);
1693  res->data=(char *)result;
1694  return FALSE;
1695}
1696#endif
1697#ifdef HAVE_FACTORY
1698static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1699{
1700  lists c=(lists)u->CopyD(); // list of ideal
1701  lists pl=NULL;
1702  intvec *p=NULL;
1703  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1704  else                    p=(intvec*)v->Data();
1705  int rl=c->nr+1;
1706  ideal result;
1707  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1708  int i;
1709  int return_type=c->m[0].Typ();
1710  if ((return_type!=IDEAL_CMD)
1711  && (return_type!=MODUL_CMD)
1712  && (return_type!=MATRIX_CMD))
1713  {
1714    WerrorS("ideal/module/matrix expected");
1715    omFree(x); // delete c
1716    return TRUE;
1717  }
1718  for(i=rl-1;i>=0;i--)
1719  {
1720    if (c->m[i].Typ()!=return_type)
1721    {
1722      Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1723      omFree(x); // delete c
1724      return TRUE;
1725    }
1726    x[i]=((ideal)c->m[i].Data());
1727  }
1728  number *q=(number *)omAlloc(rl*sizeof(number));
1729  if (p!=NULL)
1730  {
1731    for(i=rl-1;i>=0;i--)
1732    {
1733      q[i]=n_Init((*p)[i], currRing->cf);
1734    }
1735  }
1736  else
1737  {
1738    for(i=rl-1;i>=0;i--)
1739    {
1740      if (pl->m[i].Typ()==INT_CMD)
1741      {
1742        q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1743      }
1744      else if (pl->m[i].Typ()==BIGINT_CMD)
1745      {
1746        q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1747      }
1748      else
1749      {
1750        Werror("bigint expected at pos %d",i+1);
1751        for(i++;i<rl;i++)
1752        {
1753          n_Delete(&(q[i]),currRing->cf);
1754        }
1755        omFree(x); // delete c
1756        omFree(q); // delete pl
1757        return TRUE;
1758      }
1759    }
1760  }
1761  result=id_ChineseRemainder(x,q,rl,currRing);
1762  for(i=rl-1;i>=0;i--)
1763  {
1764    n_Delete(&(q[i]),currRing->cf);
1765  }
1766  omFree(q);
1767  res->data=(char *)result;
1768  res->rtyp=return_type;
1769  return FALSE;
1770}
1771#endif
1772static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1773{
1774  poly p=(poly)v->Data();
1775  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1776  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1777  return FALSE;
1778}
1779static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1780{
1781  int i=pVar((poly)v->Data());
1782  if (i==0)
1783  {
1784    WerrorS("ringvar expected");
1785    return TRUE;
1786  }
1787  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1788  return FALSE;
1789}
1790static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1791{
1792  poly p = pInit();
1793  int i;
1794  for (i=1; i<=currRing->N; i++)
1795  {
1796    pSetExp(p, i, 1);
1797  }
1798  pSetm(p);
1799  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1800                                    (ideal)(v->Data()), p);
1801  pDelete(&p);
1802  return FALSE;
1803}
1804static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1805{
1806  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1807  return FALSE;
1808}
1809static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1810{
1811  short *iv=iv2array((intvec *)v->Data(),currRing);
1812  ideal I=(ideal)u->Data();
1813  int d=-1;
1814  int i;
1815  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1816  omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1817  res->data = (char *)((long)d);
1818  return FALSE;
1819}
1820static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1821{
1822  poly p=(poly)u->Data();
1823  if (p!=NULL)
1824  {
1825    short *iv=iv2array((intvec *)v->Data(),currRing);
1826    int d=(int)pDegW(p,iv);
1827    omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1828    res->data = (char *)(long(d));
1829  }
1830  else
1831    res->data=(char *)(long)(-1);
1832  return FALSE;
1833}
1834static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1835{
1836  int i=pVar((poly)v->Data());
1837  if (i==0)
1838  {
1839    WerrorS("ringvar expected");
1840    return TRUE;
1841  }
1842  res->data=(char *)pDiff((poly)(u->Data()),i);
1843  return FALSE;
1844}
1845static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1846{
1847  int i=pVar((poly)v->Data());
1848  if (i==0)
1849  {
1850    WerrorS("ringvar expected");
1851    return TRUE;
1852  }
1853  res->data=(char *)idDiff((matrix)(u->Data()),i);
1854  return FALSE;
1855}
1856static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1857{
1858  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1859  return FALSE;
1860}
1861static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1862{
1863  assumeStdFlag(v);
1864#ifdef HAVE_RINGS
1865  if (rField_is_Ring(currRing))
1866  {
1867    ring origR = currRing;
1868    ring tempR = rCopy(origR);
1869    coeffs new_cf=nInitChar(n_Q,NULL);
1870    nKillChar(tempR->cf);
1871    tempR->cf=new_cf;
1872    rComplete(tempR);
1873    ideal vid = (ideal)v->Data();
1874    int i = idPosConstant(vid);
1875    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1876    { /* ideal v contains unit; dim = -1 */
1877      res->data = (char *)-1;
1878      return FALSE;
1879    }
1880    rChangeCurrRing(tempR);
1881    ideal vv = idrCopyR(vid, origR, currRing);
1882    ideal ww = idrCopyR((ideal)w->Data(), origR, 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(origR) && (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  BITSET save_test=test;
2491  int ul= IDELEMS((ideal)u->Data());
2492  int vl= IDELEMS((ideal)v->Data());
2493  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2494                   hasFlag(u,FLAG_STD));
2495  if (m==NULL) return TRUE;
2496  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2497  test=save_test;
2498  return FALSE;
2499}
2500static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2501{
2502  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2503  idhdl h=(idhdl)v->data;
2504  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2505  res->data = (char *)idLiftStd((ideal)u->Data(),
2506                                &(h->data.umatrix),testHomog);
2507  setFlag(res,FLAG_STD); v->flag=0;
2508  return FALSE;
2509}
2510static BOOLEAN jjLOAD2(leftv res, leftv, leftv v)
2511{
2512  return jjLOAD(res, v,TRUE);
2513}
2514static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2515{
2516  char * s=(char *)u->Data();
2517  if(strcmp(s, "with")==0)
2518    return jjLOAD(res, v, TRUE);
2519  WerrorS("invalid second argument");
2520  WerrorS("load(\"libname\" [,\"with\"]);");
2521  return TRUE;
2522}
2523static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2524{
2525  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2526  tHomog hom=testHomog;
2527  if (w_u!=NULL)
2528  {
2529    w_u=ivCopy(w_u);
2530    hom=isHomog;
2531  }
2532  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2533  if (w_v!=NULL)
2534  {
2535    w_v=ivCopy(w_v);
2536    hom=isHomog;
2537  }
2538  if ((w_u!=NULL) && (w_v==NULL))
2539    w_v=ivCopy(w_u);
2540  if ((w_v!=NULL) && (w_u==NULL))
2541    w_u=ivCopy(w_v);
2542  ideal u_id=(ideal)u->Data();
2543  ideal v_id=(ideal)v->Data();
2544  if (w_u!=NULL)
2545  {
2546     if ((*w_u).compare((w_v))!=0)
2547     {
2548       WarnS("incompatible weights");
2549       delete w_u; w_u=NULL;
2550       hom=testHomog;
2551     }
2552     else
2553     {
2554       if ((!idTestHomModule(u_id,currQuotient,w_v))
2555       || (!idTestHomModule(v_id,currQuotient,w_v)))
2556       {
2557         WarnS("wrong weights");
2558         delete w_u; w_u=NULL;
2559         hom=testHomog;
2560       }
2561     }
2562  }
2563  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2564  if (w_u!=NULL)
2565  {
2566    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2567  }
2568  delete w_v;
2569  return FALSE;
2570}
2571static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2572{
2573  number q=(number)v->Data();
2574  if (n_IsZero(q,coeffs_BIGINT))
2575  {
2576    WerrorS(ii_div_by_0);
2577    return TRUE;
2578  }
2579  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2580  return FALSE;
2581}
2582static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2583{
2584  number q=(number)v->Data();
2585  if (nIsZero(q))
2586  {
2587    WerrorS(ii_div_by_0);
2588    return TRUE;
2589  }
2590  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2591  return FALSE;
2592}
2593static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2594static BOOLEAN jjMONITOR1(leftv res, leftv v)
2595{
2596  return jjMONITOR2(res,v,NULL);
2597}
2598static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2599{
2600#if 0
2601  char *opt=(char *)v->Data();
2602  int mode=0;
2603  while(*opt!='\0')
2604  {
2605    if (*opt=='i') mode |= PROT_I;
2606    else if (*opt=='o') mode |= PROT_O;
2607    opt++;
2608  }
2609  monitor((char *)(u->Data()),mode);
2610#else
2611  si_link l=(si_link)u->Data();
2612  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2613  if(strcmp(l->m->type,"ASCII")!=0)
2614  {
2615    Werror("ASCII link required, not `%s`",l->m->type);
2616    slClose(l);
2617    return TRUE;
2618  }
2619  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2620  if ( l->name[0]!='\0') // "" is the stop condition
2621  {
2622    const char *opt;
2623    int mode=0;
2624    if (v==NULL) opt=(const char*)"i";
2625    else         opt=(const char *)v->Data();
2626    while(*opt!='\0')
2627    {
2628      if (*opt=='i') mode |= PROT_I;
2629      else if (*opt=='o') mode |= PROT_O;
2630      opt++;
2631    }
2632    monitor((FILE *)l->data,mode);
2633  }
2634  else
2635    monitor(NULL,0);
2636  return FALSE;
2637#endif
2638}
2639static BOOLEAN jjMONOM(leftv res, leftv v)
2640{
2641  intvec *iv=(intvec *)v->Data();
2642  poly p=pOne();
2643  int i,e;
2644  BOOLEAN err=FALSE;
2645  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2646  {
2647    e=(*iv)[i-1];
2648    if (e>=0) pSetExp(p,i,e);
2649    else err=TRUE;
2650  }
2651  if (iv->length()==(currRing->N+1))
2652  {
2653    res->rtyp=VECTOR_CMD;
2654    e=(*iv)[currRing->N];
2655    if (e>=0) pSetComp(p,e);
2656    else err=TRUE;
2657  }
2658  pSetm(p);
2659  res->data=(char*)p;
2660  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2661  return err;
2662}
2663static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2664{
2665  // u: the name of the new type
2666  // v: the elements
2667  newstruct_desc d=newstructFromString((const char *)v->Data());
2668  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2669  return d==NULL;
2670}
2671static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2672{
2673  idhdl h=(idhdl)u->data;
2674  int i=(int)(long)v->Data();
2675  int p=0;
2676  if ((0<i)
2677  && (rParameter(IDRING(h))!=NULL)
2678  && (i<=(p=rPar(IDRING(h)))))
2679    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2680  else
2681  {
2682    Werror("par number %d out of range 1..%d",i,p);
2683    return TRUE;
2684  }
2685  return FALSE;
2686}
2687#ifdef HAVE_PLURAL
2688static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2689{
2690  if( currRing->qideal != NULL )
2691  {
2692    WerrorS("basering must NOT be a qring!");
2693    return TRUE;
2694  }
2695
2696  if (iiOp==NCALGEBRA_CMD)
2697  {
2698    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2699  }
2700  else
2701  {
2702    ring r=rCopy(currRing);
2703    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2704    res->data=r;
2705    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2706    return result;
2707  }
2708}
2709static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2710{
2711  if( currRing->qideal != NULL )
2712  {
2713    WerrorS("basering must NOT be a qring!");
2714    return TRUE;
2715  }
2716
2717  if (iiOp==NCALGEBRA_CMD)
2718  {
2719    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2720  }
2721  else
2722  {
2723    ring r=rCopy(currRing);
2724    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2725    res->data=r;
2726    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2727    return result;
2728  }
2729}
2730static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2731{
2732  if( currRing->qideal != NULL )
2733  {
2734    WerrorS("basering must NOT be a qring!");
2735    return TRUE;
2736  }
2737
2738  if (iiOp==NCALGEBRA_CMD)
2739  {
2740    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2741  }
2742  else
2743  {
2744    ring r=rCopy(currRing);
2745    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2746    res->data=r;
2747    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2748    return result;
2749  }
2750}
2751static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2752{
2753  if( currRing->qideal != NULL )
2754  {
2755    WerrorS("basering must NOT be a qring!");
2756    return TRUE;
2757  }
2758
2759  if (iiOp==NCALGEBRA_CMD)
2760  {
2761    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2762  }
2763  else
2764  {
2765    ring r=rCopy(currRing);
2766    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2767    res->data=r;
2768    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2769    return result;
2770  }
2771}
2772static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2773{
2774  res->data=NULL;
2775
2776  if (rIsPluralRing(currRing))
2777  {
2778    const poly q = (poly)b->Data();
2779
2780    if( q != NULL )
2781    {
2782      if( (poly)a->Data() != NULL )
2783      {
2784        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2785        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2786      }
2787    }
2788  }
2789  return FALSE;
2790}
2791static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2792{
2793  /* number, poly, vector, ideal, module, matrix */
2794  ring  r = (ring)a->Data();
2795  if (r == currRing)
2796  {
2797    res->data = b->Data();
2798    res->rtyp = b->rtyp;
2799    return FALSE;
2800  }
2801  if (!rIsLikeOpposite(currRing, r))
2802  {
2803    Werror("%s is not an opposite ring to current ring",a->Fullname());
2804    return TRUE;
2805  }
2806  idhdl w;
2807  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2808  {
2809    int argtype = IDTYP(w);
2810    switch (argtype)
2811    {
2812    case NUMBER_CMD:
2813      {
2814        /* since basefields are equal, we can apply nCopy */
2815        res->data = nCopy((number)IDDATA(w));
2816        res->rtyp = argtype;
2817        break;
2818      }
2819    case POLY_CMD:
2820    case VECTOR_CMD:
2821      {
2822        poly    q = (poly)IDDATA(w);
2823        res->data = pOppose(r,q,currRing);
2824        res->rtyp = argtype;
2825        break;
2826      }
2827    case IDEAL_CMD:
2828    case MODUL_CMD:
2829      {
2830        ideal   Q = (ideal)IDDATA(w);
2831        res->data = idOppose(r,Q,currRing);
2832        res->rtyp = argtype;
2833        break;
2834      }
2835    case MATRIX_CMD:
2836      {
2837        ring save = currRing;
2838        rChangeCurrRing(r);
2839        matrix  m = (matrix)IDDATA(w);
2840        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2841        rChangeCurrRing(save);
2842        ideal   S = idOppose(r,Q,currRing);
2843        id_Delete(&Q, r);
2844        res->data = id_Module2Matrix(S,currRing);
2845        res->rtyp = argtype;
2846        break;
2847      }
2848    default:
2849      {
2850        WerrorS("unsupported type in oppose");
2851        return TRUE;
2852      }
2853    }
2854  }
2855  else
2856  {
2857    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2858    return TRUE;
2859  }
2860  return FALSE;
2861}
2862#endif /* HAVE_PLURAL */
2863
2864static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2865{
2866  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2867    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2868  id_DelMultiples((ideal)(res->data),currRing);
2869  return FALSE;
2870}
2871static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2872{
2873  int i=(int)(long)u->Data();
2874  int j=(int)(long)v->Data();
2875  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2876  return FALSE;
2877}
2878static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2879{
2880  matrix m =(matrix)u->Data();
2881  int isRowEchelon = (int)(long)v->Data();
2882  if (isRowEchelon != 1) isRowEchelon = 0;
2883  int rank = luRank(m, isRowEchelon);
2884  res->data =(char *)(long)rank;
2885  return FALSE;
2886}
2887static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2888{
2889  si_link l=(si_link)u->Data();
2890  leftv r=slRead(l,v);
2891  if (r==NULL)
2892  {
2893    const char *s;
2894    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2895    else                            s=sNoName;
2896    Werror("cannot read from `%s`",s);
2897    return TRUE;
2898  }
2899  memcpy(res,r,sizeof(sleftv));
2900  omFreeBin((ADDRESS)r, sleftv_bin);
2901  return FALSE;
2902}
2903static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2904{
2905  assumeStdFlag(v);
2906  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2907  return FALSE;
2908}
2909static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2910{
2911  assumeStdFlag(v);
2912  ideal ui=(ideal)u->Data();
2913  ideal vi=(ideal)v->Data();
2914  res->data = (char *)kNF(vi,currQuotient,ui);
2915  return FALSE;
2916}
2917#if 0
2918static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2919{
2920  int maxl=(int)(long)v->Data();
2921  if (maxl<0)
2922  {
2923    WerrorS("length for res must not be negative");
2924    return TRUE;
2925  }
2926  int l=0;
2927  //resolvente r;
2928  syStrategy r;
2929  intvec *weights=NULL;
2930  int wmaxl=maxl;
2931  ideal u_id=(ideal)u->Data();
2932
2933  maxl--;
2934  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2935  {
2936    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
2937    if (currQuotient!=NULL)
2938    {
2939      Warn(
2940      "full resolution in a qring may be infinite, setting max length to %d",
2941      maxl+1);
2942    }
2943  }
2944  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2945  if (weights!=NULL)
2946  {
2947    if (!idTestHomModule(u_id,currQuotient,weights))
2948    {
2949      WarnS("wrong weights given:");weights->show();PrintLn();
2950      weights=NULL;
2951    }
2952  }
2953  intvec *ww=NULL;
2954  int add_row_shift=0;
2955  if (weights!=NULL)
2956  {
2957     ww=ivCopy(weights);
2958     add_row_shift = ww->min_in();
2959     (*ww) -= add_row_shift;
2960  }
2961  else
2962    idHomModule(u_id,currQuotient,&ww);
2963  weights=ww;
2964
2965  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2966  {
2967    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2968  }
2969  else if (iiOp==SRES_CMD)
2970  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2971    r=sySchreyer(u_id,maxl+1);
2972  else if (iiOp == LRES_CMD)
2973  {
2974    int dummy;
2975    if((currQuotient!=NULL)||
2976    (!idHomIdeal (u_id,NULL)))
2977    {
2978       WerrorS
2979       ("`lres` not implemented for inhomogeneous input or qring");
2980       return TRUE;
2981    }
2982    r=syLaScala3(u_id,&dummy);
2983  }
2984  else if (iiOp == KRES_CMD)
2985  {
2986    int dummy;
2987    if((currQuotient!=NULL)||
2988    (!idHomIdeal (u_id,NULL)))
2989    {
2990       WerrorS
2991       ("`kres` not implemented for inhomogeneous input or qring");
2992       return TRUE;
2993    }
2994    r=syKosz(u_id,&dummy);
2995  }
2996  else
2997  {
2998    int dummy;
2999    if((currQuotient!=NULL)||
3000    (!idHomIdeal (u_id,NULL)))
3001    {
3002       WerrorS
3003       ("`hres` not implemented for inhomogeneous input or qring");
3004       return TRUE;
3005    }
3006    r=syHilb(u_id,&dummy);
3007  }
3008  if (r==NULL) return TRUE;
3009  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3010  r->list_length=wmaxl;
3011  res->data=(void *)r;
3012  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3013  {
3014    intvec *w=ivCopy(r->weights[0]);
3015    if (weights!=NULL) (*w) += add_row_shift;
3016    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3017    w=NULL;
3018  }
3019  else
3020  {
3021//#if 0
3022// need to set weights for ALL components (sres)
3023    if (weights!=NULL)
3024    {
3025      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3026      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3027      (r->weights)[0] = ivCopy(weights);
3028    }
3029//#endif
3030  }
3031  if (ww!=NULL) { delete ww; ww=NULL; }
3032  return FALSE;
3033}
3034#else
3035static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3036{
3037  int maxl=(int)(long)v->Data();
3038  if (maxl<0)
3039  {
3040    WerrorS("length for res must not be negative");
3041    return TRUE;
3042  }
3043  syStrategy r;
3044  intvec *weights=NULL;
3045  int wmaxl=maxl;
3046  ideal u_id=(ideal)u->Data();
3047
3048  maxl--;
3049  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3050  {
3051    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3052    if (currQuotient!=NULL)
3053    {
3054      Warn(
3055      "full resolution in a qring may be infinite, setting max length to %d",
3056      maxl+1);
3057    }
3058  }
3059  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3060  if (weights!=NULL)
3061  {
3062    if (!idTestHomModule(u_id,currQuotient,weights))
3063    {
3064      WarnS("wrong weights given:");weights->show();PrintLn();
3065      weights=NULL;
3066    }
3067  }
3068  intvec *ww=NULL;
3069  int add_row_shift=0;
3070  if (weights!=NULL)
3071  {
3072     ww=ivCopy(weights);
3073     add_row_shift = ww->min_in();
3074     (*ww) -= add_row_shift;
3075  }
3076  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3077  {
3078    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3079  }
3080  else if (iiOp==SRES_CMD)
3081  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3082    r=sySchreyer(u_id,maxl+1);
3083  else if (iiOp == LRES_CMD)
3084  {
3085    int dummy;
3086    if((currQuotient!=NULL)||
3087    (!idHomIdeal (u_id,NULL)))
3088    {
3089       WerrorS
3090       ("`lres` not implemented for inhomogeneous input or qring");
3091       return TRUE;
3092    }
3093    if(currRing->N == 1)
3094      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3095    r=syLaScala3(u_id,&dummy);
3096  }
3097  else if (iiOp == KRES_CMD)
3098  {
3099    int dummy;
3100    if((currQuotient!=NULL)||
3101    (!idHomIdeal (u_id,NULL)))
3102    {
3103       WerrorS
3104       ("`kres` not implemented for inhomogeneous input or qring");
3105       return TRUE;
3106    }
3107    r=syKosz(u_id,&dummy);
3108  }
3109  else
3110  {
3111    int dummy;
3112    if((currQuotient!=NULL)||
3113    (!idHomIdeal (u_id,NULL)))
3114    {
3115       WerrorS
3116       ("`hres` not implemented for inhomogeneous input or qring");
3117       return TRUE;
3118    }
3119    ideal u_id_copy=idCopy(u_id);
3120    idSkipZeroes(u_id_copy);
3121    r=syHilb(u_id_copy,&dummy);
3122    idDelete(&u_id_copy);
3123  }
3124  if (r==NULL) return TRUE;
3125  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3126  r->list_length=wmaxl;
3127  res->data=(void *)r;
3128  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3129  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3130  {
3131    ww=ivCopy(r->weights[0]);
3132    if (weights!=NULL) (*ww) += add_row_shift;
3133    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3134  }
3135  else
3136  {
3137    if (weights!=NULL)
3138    {
3139      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3140    }
3141  }
3142
3143  // test the La Scala case' output
3144  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3145  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3146
3147  if(iiOp != HRES_CMD)
3148    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3149  else
3150    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3151
3152  return FALSE;
3153}
3154#endif
3155static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3156{
3157  number n1; number n2; number temp; int i;
3158
3159  if ((u->Typ() == BIGINT_CMD) ||
3160     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3161  {
3162    temp = (number)u->Data();
3163    n1 = n_Copy(temp,coeffs_BIGINT);
3164  }
3165  else if (u->Typ() == INT_CMD)
3166  {
3167    i = (int)(long)u->Data();
3168    n1 = n_Init(i, coeffs_BIGINT);
3169  }
3170  else
3171  {
3172    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3173    return TRUE;
3174  }
3175
3176  if ((v->Typ() == BIGINT_CMD) ||
3177     ((v->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3178  {
3179    temp = (number)v->Data();
3180    n2 = n_Copy(temp,coeffs_BIGINT);
3181  }
3182  else if (v->Typ() == INT_CMD)
3183  {
3184    i = (int)(long)v->Data();
3185    n2 = n_Init(i, coeffs_BIGINT);
3186  }
3187  else
3188  {
3189    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3190    return TRUE;
3191  }
3192
3193  lists l = primeFactorisation(n1, n2);
3194  n_Delete(&n1, coeffs_BIGINT); n_Delete(&n2, coeffs_BIGINT);
3195  res->data = (char*)l;
3196  return FALSE;
3197}
3198static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3199{
3200  ring r;
3201  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3202  res->data = (char *)r;
3203  return (i==-1);
3204}
3205#define SIMPL_LMDIV 32
3206#define SIMPL_LMEQ  16
3207#define SIMPL_MULT 8
3208#define SIMPL_EQU  4
3209#define SIMPL_NULL 2
3210#define SIMPL_NORM 1
3211static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3212{
3213  int sw = (int)(long)v->Data();
3214  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3215  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3216  if (sw & SIMPL_LMDIV)
3217  {
3218    id_DelDiv(id,currRing);
3219  }
3220  if (sw & SIMPL_LMEQ)
3221  {
3222    id_DelLmEquals(id,currRing);
3223  }
3224  if (sw & SIMPL_MULT)
3225  {
3226    id_DelMultiples(id,currRing);
3227  }
3228  else if(sw & SIMPL_EQU)
3229  {
3230    id_DelEquals(id,currRing);
3231  }
3232  if (sw & SIMPL_NULL)
3233  {
3234    idSkipZeroes(id);
3235  }
3236  if (sw & SIMPL_NORM)
3237  {
3238    id_Norm(id,currRing);
3239  }
3240  res->data = (char * )id;
3241  return FALSE;
3242}
3243#ifdef HAVE_FACTORY
3244extern int singclap_factorize_retry;
3245static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3246{
3247  intvec *v=NULL;
3248  int sw=(int)(long)dummy->Data();
3249  int fac_sw=sw;
3250  if (sw<0) fac_sw=1;
3251  singclap_factorize_retry=0;
3252  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3253  if (f==NULL)
3254    return TRUE;
3255  switch(sw)
3256  {
3257    case 0:
3258    case 2:
3259    {
3260      lists l=(lists)omAllocBin(slists_bin);
3261      l->Init(2);
3262      l->m[0].rtyp=IDEAL_CMD;
3263      l->m[0].data=(void *)f;
3264      l->m[1].rtyp=INTVEC_CMD;
3265      l->m[1].data=(void *)v;
3266      res->data=(void *)l;
3267      res->rtyp=LIST_CMD;
3268      return FALSE;
3269    }
3270    case 1:
3271      res->data=(void *)f;
3272      return FALSE;
3273    case 3:
3274      {
3275        poly p=f->m[0];
3276        int i=IDELEMS(f);
3277        f->m[0]=NULL;
3278        while(i>1)
3279        {
3280          i--;
3281          p=pMult(p,f->m[i]);
3282          f->m[i]=NULL;
3283        }
3284        res->data=(void *)p;
3285        res->rtyp=POLY_CMD;
3286      }
3287      return FALSE;
3288  }
3289  WerrorS("invalid switch");
3290  return FALSE;
3291}
3292#endif
3293static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3294{
3295  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3296  return FALSE;
3297}
3298static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3299{
3300  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3301  //return (res->data== (void*)(long)-2);
3302  return FALSE;
3303}
3304static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3305{
3306  int sw = (int)(long)v->Data();
3307  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3308  poly p = (poly)u->CopyD(POLY_CMD);
3309  if (sw & SIMPL_NORM)
3310  {
3311    pNorm(p);
3312  }
3313  res->data = (char * )p;
3314  return FALSE;
3315}
3316static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3317{
3318  ideal result;
3319  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3320  tHomog hom=testHomog;
3321  ideal u_id=(ideal)(u->Data());
3322  if (w!=NULL)
3323  {
3324    if (!idTestHomModule(u_id,currQuotient,w))
3325    {
3326      WarnS("wrong weights:");w->show();PrintLn();
3327      w=NULL;
3328    }
3329    else
3330    {
3331      w=ivCopy(w);
3332      hom=isHomog;
3333    }
3334  }
3335  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3336  idSkipZeroes(result);
3337  res->data = (char *)result;
3338  setFlag(res,FLAG_STD);
3339  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3340  return FALSE;
3341}
3342static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3343static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3344/* destroys i0, p0 */
3345/* result (with attributes) in res */
3346/* i0: SB*/
3347/* t0: type of p0*/
3348/* p0 new elements*/
3349/* a attributes of i0*/
3350{
3351  int tp;
3352  if (t0==IDEAL_CMD) tp=POLY_CMD;
3353  else               tp=VECTOR_CMD;
3354  for (int i=IDELEMS(p0)-1; i>=0; i--)
3355  {
3356    poly p=p0->m[i];
3357    p0->m[i]=NULL;
3358    if (p!=NULL)
3359    {
3360      sleftv u0,v0;
3361      memset(&u0,0,sizeof(sleftv));
3362      memset(&v0,0,sizeof(sleftv));
3363      v0.rtyp=tp;
3364      v0.data=(void*)p;
3365      u0.rtyp=t0;
3366      u0.data=i0;
3367      u0.attribute=a;
3368      setFlag(&u0,FLAG_STD);
3369      jjSTD_1(res,&u0,&v0);
3370      i0=(ideal)res->data;
3371      res->data=NULL;
3372      a=res->attribute;
3373      res->attribute=NULL;
3374      u0.CleanUp();
3375      v0.CleanUp();
3376      res->CleanUp();
3377    }
3378  }
3379  idDelete(&p0);
3380  res->attribute=a;
3381  res->data=(void *)i0;
3382  res->rtyp=t0;
3383}
3384static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3385{
3386  ideal result;
3387  assumeStdFlag(u);
3388  ideal i1=(ideal)(u->Data());
3389  ideal i0;
3390  int r=v->Typ();
3391  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3392  {
3393    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3394    i0->m[0]=(poly)v->Data();
3395    int ii0=idElem(i0); /* size of i0 */
3396    i1=idSimpleAdd(i1,i0); //
3397    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3398    idDelete(&i0);
3399    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3400    tHomog hom=testHomog;
3401
3402    if (w!=NULL)
3403    {
3404      if (!idTestHomModule(i1,currQuotient,w))
3405      {
3406        // no warnung: this is legal, if i in std(i,p)
3407        // is homogeneous, but p not
3408        w=NULL;
3409      }
3410      else
3411      {
3412        w=ivCopy(w);
3413        hom=isHomog;
3414      }
3415    }
3416    BITSET save_test=test;
3417    test|=Sy_bit(OPT_SB_1);
3418    /* ii0 appears to be the position of the first element of il that
3419       does not belong to the old SB ideal */
3420    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3421    test=save_test;
3422    idDelete(&i1);
3423    idSkipZeroes(result);
3424    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3425    res->data = (char *)result;
3426  }
3427  else /*IDEAL/MODULE*/
3428  {
3429    attr *aa=u->Attribute();
3430    attr a=NULL;
3431    if (aa!=NULL) a=(*aa)->Copy();
3432    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3433  }
3434  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3435  return FALSE;
3436}
3437static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3438{
3439  idhdl h=(idhdl)u->data;
3440  int i=(int)(long)v->Data();
3441  if ((0<i) && (i<=IDRING(h)->N))
3442    res->data=omStrDup(IDRING(h)->names[i-1]);
3443  else
3444  {
3445    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3446    return TRUE;
3447  }
3448  return FALSE;
3449}
3450static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3451{
3452// input: u: a list with links of type
3453//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3454//        v: timeout for select in milliseconds
3455//           or 0 for polling
3456// returns: ERROR (via Werror): timeout negative
3457//           -1: the read state of all links is eof
3458//            0: timeout (or polling): none ready
3459//           i>0: (at least) L[i] is ready
3460  lists Lforks = (lists)u->Data();
3461  int t = (int)(long)v->Data();
3462  if(t < 0)
3463  {
3464    WerrorS("negative timeout"); return TRUE;
3465  }
3466  int i = slStatusSsiL(Lforks, t*1000);
3467  if(i == -2) /* error */
3468  {
3469    return TRUE;
3470  }
3471  res->data = (void*)(long)i;
3472  return FALSE;
3473}
3474static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3475{
3476// input: u: a list with links of type
3477//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3478//        v: timeout for select in milliseconds
3479//           or 0 for polling
3480// returns: ERROR (via Werror): timeout negative
3481//           -1: the read state of all links is eof
3482//           0: timeout (or polling): none ready
3483//           1: all links are ready
3484//              (caution: at least one is ready, but some maybe dead)
3485  lists Lforks = (lists)u->CopyD();
3486  int timeout = 1000*(int)(long)v->Data();
3487  if(timeout < 0)
3488  {
3489    WerrorS("negative timeout"); return TRUE;
3490  }
3491  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3492  int i;
3493  int ret = -1;
3494  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3495  {
3496    i = slStatusSsiL(Lforks, timeout);
3497    if(i > 0) /* Lforks[i] is ready */
3498    {
3499      ret = 1;
3500      Lforks->m[i-1].CleanUp();
3501      Lforks->m[i-1].rtyp=DEF_CMD;
3502      Lforks->m[i-1].data=NULL;
3503      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3504    }
3505    else /* terminate the for loop */
3506    {
3507      if(i == -2) /* error */
3508      {
3509        return TRUE;
3510      }
3511      if(i == 0) /* timeout */
3512      {
3513        ret = 0;
3514      }
3515      break;
3516    }
3517  }
3518  Lforks->Clean();
3519  res->data = (void*)(long)ret;
3520  return FALSE;
3521}
3522static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3523{
3524  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3525  return FALSE;
3526}
3527#define jjWRONG2 (proc2)jjWRONG
3528#define jjWRONG3 (proc3)jjWRONG
3529static BOOLEAN jjWRONG(leftv, leftv)
3530{
3531  return TRUE;
3532}
3533
3534/*=================== operations with 1 arg.: static proc =================*/
3535/* must be ordered: first operations for chars (infix ops),
3536 * then alphabetically */
3537
3538static BOOLEAN jjDUMMY(leftv res, leftv u)
3539{
3540  res->data = (char *)u->CopyD();
3541  return FALSE;
3542}
3543static BOOLEAN jjNULL(leftv, leftv)
3544{
3545  return FALSE;
3546}
3547//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3548//{
3549//  res->data = (char *)((int)(long)u->Data()+1);
3550//  return FALSE;
3551//}
3552//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3553//{
3554//  res->data = (char *)((int)(long)u->Data()-1);
3555//  return FALSE;
3556//}
3557static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3558{
3559  if (IDTYP((idhdl)u->data)==INT_CMD)
3560  {
3561    int i=IDINT((idhdl)u->data);
3562    if (iiOp==PLUSPLUS) i++;
3563    else                i--;
3564    IDDATA((idhdl)u->data)=(char *)(long)i;
3565    return FALSE;
3566  }
3567  return TRUE;
3568}
3569static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3570{
3571  number n=(number)u->CopyD(BIGINT_CMD);
3572  n=n_Neg(n,coeffs_BIGINT);
3573  res->data = (char *)n;
3574  return FALSE;
3575}
3576static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3577{
3578  res->data = (char *)(-(long)u->Data());
3579  return FALSE;
3580}
3581static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3582{
3583  number n=(number)u->CopyD(NUMBER_CMD);
3584  n=nNeg(n);
3585  res->data = (char *)n;
3586  return FALSE;
3587}
3588static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3589{
3590  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3591  return FALSE;
3592}
3593static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3594{
3595  poly m1=pISet(-1);
3596  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3597  return FALSE;
3598}
3599static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3600{
3601  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3602  (*iv)*=(-1);
3603  res->data = (char *)iv;
3604  return FALSE;
3605}
3606static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3607{
3608  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3609  (*bim)*=(-1);
3610  res->data = (char *)bim;
3611  return FALSE;
3612}
3613static BOOLEAN jjPROC1(leftv res, leftv u)
3614{
3615  return jjPROC(res,u,NULL);
3616}
3617static BOOLEAN jjBAREISS(leftv res, leftv v)
3618{
3619  //matrix m=(matrix)v->Data();
3620  //lists l=mpBareiss(m,FALSE);
3621  intvec *iv;
3622  ideal m;
3623  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3624  lists l=(lists)omAllocBin(slists_bin);
3625  l->Init(2);
3626  l->m[0].rtyp=MODUL_CMD;
3627  l->m[1].rtyp=INTVEC_CMD;
3628  l->m[0].data=(void *)m;
3629  l->m[1].data=(void *)iv;
3630  res->data = (char *)l;
3631  return FALSE;
3632}
3633//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3634//{
3635//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3636//  ivTriangMat(m);
3637//  res->data = (char *)m;
3638//  return FALSE;
3639//}
3640static BOOLEAN jjBI2N(leftv res, leftv u)
3641{
3642  BOOLEAN bo=FALSE;
3643  number n=(number)u->CopyD();
3644  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3645  if (nMap!=NULL)
3646    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3647  else
3648  {
3649    WerrorS("cannot convert bigint to this field");
3650    bo=TRUE;
3651  }
3652  n_Delete(&n,coeffs_BIGINT);
3653  return bo;
3654}
3655static BOOLEAN jjBI2P(leftv res, leftv u)
3656{
3657  sleftv tmp;
3658  BOOLEAN bo=jjBI2N(&tmp,u);
3659  if (!bo)
3660  {
3661    number n=(number) tmp.data;
3662    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3663    else
3664    {
3665      res->data=(void *)pNSet(n);
3666    }
3667  }
3668  return bo;
3669}
3670static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3671{
3672  return iiExprArithM(res,u,iiOp);
3673}
3674static BOOLEAN jjCHAR(leftv res, leftv v)
3675{
3676  res->data = (char *)(long)rChar((ring)v->Data());
3677  return FALSE;
3678}
3679static BOOLEAN jjCOLS(leftv res, leftv v)
3680{
3681  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3682  return FALSE;
3683}
3684static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3685{
3686  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3687  return FALSE;
3688}
3689static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3690{
3691  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3692  return FALSE;
3693}
3694static BOOLEAN jjCONTENT(leftv res, leftv v)
3695{
3696  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3697  poly p=(poly)v->CopyD(POLY_CMD);
3698  if (p!=NULL) p_Cleardenom(p, currRing);
3699  res->data = (char *)p;
3700  return FALSE;
3701}
3702static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3703{
3704  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3705  return FALSE;
3706}
3707static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3708{
3709  res->data = (char *)(long)nSize((number)v->Data());
3710  return FALSE;
3711}
3712static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3713{
3714  lists l=(lists)v->Data();
3715  res->data = (char *)(long)(lSize(l)+1);
3716  return FALSE;
3717}
3718static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3719{
3720  matrix m=(matrix)v->Data();
3721  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3722  return FALSE;
3723}
3724static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3725{
3726  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3727  return FALSE;
3728}
3729static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3730{
3731  ring r=(ring)v->Data();
3732  int elems=-1;
3733  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3734  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3735  {
3736#ifdef HAVE_FACTORY
3737    extern int ipower ( int b, int n ); /* factory/cf_util */
3738    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3739#else
3740    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3741#endif
3742  }
3743  res->data = (char *)(long)elems;
3744  return FALSE;
3745}
3746static BOOLEAN jjDEG(leftv res, leftv v)
3747{
3748  int dummy;
3749  poly p=(poly)v->Data();
3750  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3751  else res->data=(char *)-1;
3752  return FALSE;
3753}
3754static BOOLEAN jjDEG_M(leftv res, leftv u)
3755{
3756  ideal I=(ideal)u->Data();
3757  int d=-1;
3758  int dummy;
3759  int i;
3760  for(i=IDELEMS(I)-1;i>=0;i--)
3761    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3762  res->data = (char *)(long)d;
3763  return FALSE;
3764}
3765static BOOLEAN jjDEGREE(leftv res, leftv v)
3766{
3767  SPrintStart();
3768#ifdef HAVE_RINGS
3769  if (rField_is_Ring_Z(currRing))
3770  {
3771    ring origR = currRing;
3772    ring tempR = rCopy(origR);
3773    coeffs new_cf=nInitChar(n_Q,NULL);
3774    nKillChar(tempR->cf);
3775    tempR->cf=new_cf;
3776    rComplete(tempR);
3777    ideal vid = (ideal)v->Data();
3778    rChangeCurrRing(tempR);
3779    ideal vv = idrCopyR(vid, origR, currRing);
3780    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3781    vvAsLeftv.rtyp = IDEAL_CMD;
3782    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3783    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3784    assumeStdFlag(&vvAsLeftv);
3785    Print("// NOTE: computation of degree is being performed for\n");
3786    Print("//       generic fibre, that is, over Q\n");
3787    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3788    scDegree(vv,module_w,currQuotient);
3789    idDelete(&vv);
3790    rChangeCurrRing(origR);
3791    rDelete(tempR);
3792  }
3793#endif
3794  assumeStdFlag(v);
3795  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3796  scDegree((ideal)v->Data(),module_w,currQuotient);
3797  char *s=SPrintEnd();
3798  int l=strlen(s)-1;
3799  s[l]='\0';
3800  res->data=(void*)s;
3801  return FALSE;
3802}
3803static BOOLEAN jjDEFINED(leftv res, leftv v)
3804{
3805  if ((v->rtyp==IDHDL)
3806  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3807  {
3808    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3809  }
3810  else if (v->rtyp!=0) res->data=(void *)(-1);
3811  return FALSE;
3812}
3813
3814/// Return the denominator of the input number
3815/// NOTE: the input number is normalized as a side effect
3816static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3817{
3818  number n = reinterpret_cast<number>(v->Data());
3819  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3820  return FALSE;
3821}
3822
3823/// Return the numerator of the input number
3824/// NOTE: the input number is normalized as a side effect
3825static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3826{
3827  number n = reinterpret_cast<number>(v->Data());
3828  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3829  return FALSE;
3830}
3831
3832
3833
3834
3835#ifdef HAVE_FACTORY
3836static BOOLEAN jjDET(leftv res, leftv v)
3837{
3838  matrix m=(matrix)v->Data();
3839  poly p;
3840  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3841  {
3842    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3843    p=sm_CallDet(I, currRing);
3844    idDelete(&I);
3845  }
3846  else
3847    p=singclap_det(m,currRing);
3848  res ->data = (char *)p;
3849  return FALSE;
3850}
3851static BOOLEAN jjDET_BI(leftv res, leftv v)
3852{
3853  bigintmat * m=(bigintmat*)v->Data();
3854  int i,j;
3855  i=m->rows();j=m->cols();
3856  if(i==j)
3857    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3858  else
3859  {
3860    Werror("det of %d x %d bigintmat",i,j);
3861    return TRUE;
3862  }
3863  return FALSE;
3864}
3865static BOOLEAN jjDET_I(leftv res, leftv v)
3866{
3867  intvec * m=(intvec*)v->Data();
3868  int i,j;
3869  i=m->rows();j=m->cols();
3870  if(i==j)
3871    res->data = (char *)(long)singclap_det_i(m,currRing);
3872  else
3873  {
3874    Werror("det of %d x %d intmat",i,j);
3875    return TRUE;
3876  }
3877  return FALSE;
3878}
3879static BOOLEAN jjDET_S(leftv res, leftv v)
3880{
3881  ideal I=(ideal)v->Data();
3882  poly p;
3883  if (IDELEMS(I)<1) return TRUE;
3884  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3885  {
3886    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3887    p=singclap_det(m,currRing);
3888    idDelete((ideal *)&m);
3889  }
3890  else
3891    p=sm_CallDet(I, currRing);
3892  res->data = (char *)p;
3893  return FALSE;
3894}
3895#endif
3896static BOOLEAN jjDIM(leftv res, leftv v)
3897{
3898  assumeStdFlag(v);
3899#ifdef HAVE_RINGS
3900  if (rField_is_Ring(currRing))
3901  {
3902    ring origR = currRing;
3903    ring tempR = rCopy(origR);
3904    coeffs new_cf=nInitChar(n_Q,NULL);
3905    nKillChar(tempR->cf);
3906    tempR->cf=new_cf;
3907    rComplete(tempR);
3908    ideal vid = (ideal)v->Data();
3909    int i = idPosConstant(vid);
3910    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3911    { /* ideal v contains unit; dim = -1 */
3912      res->data = (char *)-1;
3913      return FALSE;
3914    }
3915    rChangeCurrRing(tempR);
3916    ideal vv = idrCopyR(vid, origR, 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(origR) && (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 (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  BITSET save_test=test;
6414  int ul= IDELEMS((ideal)u->Data());
6415  int vl= IDELEMS((ideal)v->Data());
6416  ideal m
6417    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6418             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6419  if (m==NULL) return TRUE;
6420  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6421  test=save_test;
6422  return FALSE;
6423}
6424static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6425{
6426  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6427  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6428  idhdl hv=(idhdl)v->data;
6429  idhdl hw=(idhdl)w->data;
6430  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6431  res->data = (char *)idLiftStd((ideal)u->Data(),
6432                                &(hv->data.umatrix),testHomog,
6433                                &(hw->data.uideal));
6434  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6435  return FALSE;
6436}
6437static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6438{
6439  assumeStdFlag(v);
6440  if (!idIsZeroDim((ideal)v->Data()))
6441  {
6442    Werror("`%s` must be 0-dimensional",v->Name());
6443    return TRUE;
6444  }
6445  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6446    (poly)w->CopyD());
6447  return FALSE;
6448}
6449static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6450{
6451  assumeStdFlag(v);
6452  if (!idIsZeroDim((ideal)v->Data()))
6453  {
6454    Werror("`%s` must be 0-dimensional",v->Name());
6455    return TRUE;
6456  }
6457  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6458    (matrix)w->CopyD());
6459  return FALSE;
6460}
6461static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6462{
6463  assumeStdFlag(v);
6464  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6465    0,(int)(long)w->Data());
6466  return FALSE;
6467}
6468static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6469{
6470  assumeStdFlag(v);
6471  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6472    0,(int)(long)w->Data());
6473  return FALSE;
6474}
6475#ifdef OLD_RES
6476static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6477{
6478  int maxl=(int)v->Data();
6479  ideal u_id=(ideal)u->Data();
6480  int l=0;
6481  resolvente r;
6482  intvec **weights=NULL;
6483  int wmaxl=maxl;
6484  maxl--;
6485  if ((maxl==-1) && (iiOp!=MRES_CMD))
6486    maxl = currRing->N-1;
6487  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6488  {
6489    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6490    if (iv!=NULL)
6491    {
6492      l=1;
6493      if (!idTestHomModule(u_id,currQuotient,iv))
6494      {
6495        WarnS("wrong weights");
6496        iv=NULL;
6497      }
6498      else
6499      {
6500        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6501        weights[0] = ivCopy(iv);
6502      }
6503    }
6504    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6505  }
6506  else
6507    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6508  if (r==NULL) return TRUE;
6509  int t3=u->Typ();
6510  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6511  return FALSE;
6512}
6513#endif
6514static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6515{
6516  res->data=(void *)rInit(u,v,w);
6517  return (res->data==NULL);
6518}
6519static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6520{
6521  int yes;
6522  jjSTATUS2(res, u, v);
6523  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6524  omFree((ADDRESS) res->data);
6525  res->data = (void *)(long)yes;
6526  return FALSE;
6527}
6528static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6529{
6530  intvec *vw=(intvec *)w->Data(); // weights of vars
6531  if (vw->length()!=currRing->N)
6532  {
6533    Werror("%d weights for %d variables",vw->length(),currRing->N);
6534    return TRUE;
6535  }
6536  ideal result;
6537  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6538  tHomog hom=testHomog;
6539  ideal u_id=(ideal)(u->Data());
6540  if (ww!=NULL)
6541  {
6542    if (!idTestHomModule(u_id,currQuotient,ww))
6543    {
6544      WarnS("wrong weights");
6545      ww=NULL;
6546    }
6547    else
6548    {
6549      ww=ivCopy(ww);
6550      hom=isHomog;
6551    }
6552  }
6553  result=kStd(u_id,
6554              currQuotient,
6555              hom,
6556              &ww,                  // module weights
6557              (intvec *)v->Data(),  // hilbert series
6558              0,0,                  // syzComp, newIdeal
6559              vw);                  // weights of vars
6560  idSkipZeroes(result);
6561  res->data = (char *)result;
6562  setFlag(res,FLAG_STD);
6563  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6564  return FALSE;
6565}
6566
6567/*=================== operations with many arg.: static proc =================*/
6568/* must be ordered: first operations for chars (infix ops),
6569 * then alphabetically */
6570static BOOLEAN jjBREAK0(leftv, leftv)
6571{
6572#ifdef HAVE_SDB
6573  sdb_show_bp();
6574#endif
6575  return FALSE;
6576}
6577static BOOLEAN jjBREAK1(leftv, leftv v)
6578{
6579#ifdef HAVE_SDB
6580  if(v->Typ()==PROC_CMD)
6581  {
6582    int lineno=0;
6583    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6584    {
6585      lineno=(int)(long)v->next->Data();
6586    }
6587    return sdb_set_breakpoint(v->Name(),lineno);
6588  }
6589  return TRUE;
6590#else
6591 return FALSE;
6592#endif
6593}
6594static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6595{
6596  return iiExprArith1(res,v,iiOp);
6597}
6598static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6599{
6600  leftv v=u->next;
6601  u->next=NULL;
6602  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6603  u->next=v;
6604  return b;
6605}
6606static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6607{
6608  leftv v = u->next;
6609  leftv w = v->next;
6610  u->next = NULL;
6611  v->next = NULL;
6612  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6613  u->next = v;
6614  v->next = w;
6615  return b;
6616}
6617
6618static BOOLEAN jjCOEF_M(leftv, leftv v)
6619{
6620  if((v->Typ() != VECTOR_CMD)
6621  || (v->next->Typ() != POLY_CMD)
6622  || (v->next->next->Typ() != MATRIX_CMD)
6623  || (v->next->next->next->Typ() != MATRIX_CMD))
6624     return TRUE;
6625  if (v->next->next->rtyp!=IDHDL) return TRUE;
6626  idhdl c=(idhdl)v->next->next->data;
6627  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6628  idhdl m=(idhdl)v->next->next->next->data;
6629  idDelete((ideal *)&(c->data.uideal));
6630  idDelete((ideal *)&(m->data.uideal));
6631  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6632    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6633  return FALSE;
6634}
6635
6636static BOOLEAN jjDIVISION4(leftv res, leftv v)
6637{ // may have 3 or 4 arguments
6638  leftv v1=v;
6639  leftv v2=v1->next;
6640  leftv v3=v2->next;
6641  leftv v4=v3->next;
6642  assumeStdFlag(v2);
6643
6644  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6645  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6646
6647  if((i1==0)||(i2==0)
6648  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6649  {
6650    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6651    return TRUE;
6652  }
6653
6654  sleftv w1,w2;
6655  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6656  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6657  ideal P=(ideal)w1.Data();
6658  ideal Q=(ideal)w2.Data();
6659
6660  int n=(int)(long)v3->Data();
6661  short *w=NULL;
6662  if(v4!=NULL)
6663  {
6664    w=iv2array((intvec *)v4->Data(),currRing);
6665    short *w0=w+1;
6666    int i=currRing->N;
6667    while(i>0&&*w0>0)
6668    {
6669      w0++;
6670      i--;
6671    }
6672    if(i>0)
6673      WarnS("not all weights are positive!");
6674  }
6675
6676  matrix T;
6677  ideal R;
6678  idLiftW(P,Q,n,T,R,w);
6679
6680  w1.CleanUp();
6681  w2.CleanUp();
6682  if(w!=NULL)
6683    omFree(w);
6684
6685  lists L=(lists) omAllocBin(slists_bin);
6686  L->Init(2);
6687  L->m[1].rtyp=v1->Typ();
6688  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6689  {
6690    if(v1->Typ()==POLY_CMD)
6691      p_Shift(&R->m[0],-1,currRing);
6692    L->m[1].data=(void *)R->m[0];
6693    R->m[0]=NULL;
6694    idDelete(&R);
6695  }
6696  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6697    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6698  else
6699  {
6700    L->m[1].rtyp=MODUL_CMD;
6701    L->m[1].data=(void *)R;
6702  }
6703  L->m[0].rtyp=MATRIX_CMD;
6704  L->m[0].data=(char *)T;
6705
6706  res->data=L;
6707  res->rtyp=LIST_CMD;
6708
6709  return FALSE;
6710}
6711
6712//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6713//{
6714//  int l=u->listLength();
6715//  if (l<2) return TRUE;
6716//  BOOLEAN b;
6717//  leftv v=u->next;
6718//  leftv zz=v;
6719//  leftv z=zz;
6720//  u->next=NULL;
6721//  do
6722//  {
6723//    leftv z=z->next;
6724//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6725//    if (b) break;
6726//  } while (z!=NULL);
6727//  u->next=zz;
6728//  return b;
6729//}
6730static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6731{
6732  int s=1;
6733  leftv h=v;
6734  if (h!=NULL) s=exprlist_length(h);
6735  ideal id=idInit(s,1);
6736  int rank=1;
6737  int i=0;
6738  poly p;
6739  while (h!=NULL)
6740  {
6741    switch(h->Typ())
6742    {
6743      case POLY_CMD:
6744      {
6745        p=(poly)h->CopyD(POLY_CMD);
6746        break;
6747      }
6748      case INT_CMD:
6749      {
6750        number n=nInit((int)(long)h->Data());
6751        if (!nIsZero(n))
6752        {
6753          p=pNSet(n);
6754        }
6755        else
6756        {
6757          p=NULL;
6758          nDelete(&n);
6759        }
6760        break;
6761      }
6762      case BIGINT_CMD:
6763      {
6764        number b=(number)h->Data();
6765        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6766        if (!nIsZero(n))
6767        {
6768          p=pNSet(n);
6769        }
6770        else
6771        {
6772          p=NULL;
6773          nDelete(&n);
6774        }
6775        break;
6776      }
6777      case NUMBER_CMD:
6778      {
6779        number n=(number)h->CopyD(NUMBER_CMD);
6780        if (!nIsZero(n))
6781        {
6782          p=pNSet(n);
6783        }
6784        else
6785        {
6786          p=NULL;
6787          nDelete(&n);
6788        }
6789        break;
6790      }
6791      case VECTOR_CMD:
6792      {
6793        p=(poly)h->CopyD(VECTOR_CMD);
6794        if (iiOp!=MODUL_CMD)
6795        {
6796          idDelete(&id);
6797          pDelete(&p);
6798          return TRUE;
6799        }
6800        rank=si_max(rank,(int)pMaxComp(p));
6801        break;
6802      }
6803      default:
6804      {
6805        idDelete(&id);
6806        return TRUE;
6807      }
6808    }
6809    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6810    {
6811      pSetCompP(p,1);
6812    }
6813    id->m[i]=p;
6814    i++;
6815    h=h->next;
6816  }
6817  id->rank=rank;
6818  res->data=(char *)id;
6819  return FALSE;
6820}
6821static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6822{
6823  leftv h=v;
6824  int l=v->listLength();
6825  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6826  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6827  int t=0;
6828  // try to convert to IDEAL_CMD
6829  while (h!=NULL)
6830  {
6831    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6832    {
6833      t=IDEAL_CMD;
6834    }
6835    else break;
6836    h=h->next;
6837  }
6838  // if failure, try MODUL_CMD
6839  if (t==0)
6840  {
6841    h=v;
6842    while (h!=NULL)
6843    {
6844      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6845      {
6846        t=MODUL_CMD;
6847      }
6848      else break;
6849      h=h->next;
6850    }
6851  }
6852  // check for success  in converting
6853  if (t==0)
6854  {
6855    WerrorS("cannot convert to ideal or module");
6856    return TRUE;
6857  }
6858  // call idMultSect
6859  h=v;
6860  int i=0;
6861  sleftv tmp;
6862  while (h!=NULL)
6863  {
6864    if (h->Typ()==t)
6865    {
6866      r[i]=(ideal)h->Data(); /*no copy*/
6867      h=h->next;
6868    }
6869    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6870    {
6871      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6872      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6873      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6874      return TRUE;
6875    }
6876    else
6877    {
6878      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6879      copied[i]=TRUE;
6880      h=tmp.next;
6881    }
6882    i++;
6883  }
6884  res->rtyp=t;
6885  res->data=(char *)idMultSect(r,i);
6886  while(i>0)
6887  {
6888    i--;
6889    if (copied[i]) idDelete(&(r[i]));
6890  }
6891  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6892  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6893  return FALSE;
6894}
6895static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6896{
6897  /* computation of the inverse of a quadratic matrix A
6898     using the L-U-decomposition of A;
6899     There are two valid parametrisations:
6900     1) exactly one argument which is just the matrix A,
6901     2) exactly three arguments P, L, U which already
6902        realise the L-U-decomposition of A, that is,
6903        P * A = L * U, and P, L, and U satisfy the
6904        properties decribed in method 'jjLU_DECOMP';
6905        see there;
6906     If A is invertible, the list [1, A^(-1)] is returned,
6907     otherwise the list [0] is returned. Thus, the user may
6908     inspect the first entry of the returned list to see
6909     whether A is invertible. */
6910  matrix iMat; int invertible;
6911  if (v->next == NULL)
6912  {
6913    if (v->Typ() != MATRIX_CMD)
6914    {
6915      Werror("expected either one or three matrices");
6916      return TRUE;
6917    }
6918    else
6919    {
6920      matrix aMat = (matrix)v->Data();
6921      int rr = aMat->rows();
6922      int cc = aMat->cols();
6923      if (rr != cc)
6924      {
6925        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6926        return TRUE;
6927      }
6928      if (!idIsConstant((ideal)aMat))
6929      {
6930        WerrorS("matrix must be constant");
6931        return TRUE;
6932      }
6933      invertible = luInverse(aMat, iMat);
6934    }
6935  }
6936  else if ((v->Typ() == MATRIX_CMD) &&
6937           (v->next->Typ() == MATRIX_CMD) &&
6938           (v->next->next != NULL) &&
6939           (v->next->next->Typ() == MATRIX_CMD) &&
6940           (v->next->next->next == NULL))
6941  {
6942     matrix pMat = (matrix)v->Data();
6943     matrix lMat = (matrix)v->next->Data();
6944     matrix uMat = (matrix)v->next->next->Data();
6945     int rr = uMat->rows();
6946     int cc = uMat->cols();
6947     if (rr != cc)
6948     {
6949       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6950              rr, cc);
6951       return TRUE;
6952     }
6953      if (!idIsConstant((ideal)pMat)
6954      || (!idIsConstant((ideal)lMat))
6955      || (!idIsConstant((ideal)uMat))
6956      )
6957      {
6958        WerrorS("matricesx must be constant");
6959        return TRUE;
6960      }
6961     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6962  }
6963  else
6964  {
6965    Werror("expected either one or three matrices");
6966    return TRUE;
6967  }
6968
6969  /* build the return structure; a list with either one or two entries */
6970  lists ll = (lists)omAllocBin(slists_bin);
6971  if (invertible)
6972  {
6973    ll->Init(2);
6974    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6975    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6976  }
6977  else
6978  {
6979    ll->Init(1);
6980    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6981  }
6982
6983  res->data=(char*)ll;
6984  return FALSE;
6985}
6986static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6987{
6988  /* for solving a linear equation system A * x = b, via the
6989     given LU-decomposition of the matrix A;
6990     There is one valid parametrisation:
6991     1) exactly four arguments P, L, U, b;
6992        P, L, and U realise the L-U-decomposition of A, that is,
6993        P * A = L * U, and P, L, and U satisfy the
6994        properties decribed in method 'jjLU_DECOMP';
6995        see there;
6996        b is the right-hand side vector of the equation system;
6997     The method will return a list of either 1 entry or three entries:
6998     1) [0] if there is no solution to the system;
6999     2) [1, x, H] if there is at least one solution;
7000        x is any solution of the given linear system,
7001        H is the matrix with column vectors spanning the homogeneous
7002        solution space.
7003     The method produces an error if matrix and vector sizes do not fit. */
7004  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
7005      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
7006      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
7007      (v->next->next->next == NULL) ||
7008      (v->next->next->next->Typ() != MATRIX_CMD) ||
7009      (v->next->next->next->next != NULL))
7010  {
7011    WerrorS("expected exactly three matrices and one vector as input");
7012    return TRUE;
7013  }
7014  matrix pMat = (matrix)v->Data();
7015  matrix lMat = (matrix)v->next->Data();
7016  matrix uMat = (matrix)v->next->next->Data();
7017  matrix bVec = (matrix)v->next->next->next->Data();
7018  matrix xVec; int solvable; matrix homogSolSpace;
7019  if (pMat->rows() != pMat->cols())
7020  {
7021    Werror("first matrix (%d x %d) is not quadratic",
7022           pMat->rows(), pMat->cols());
7023    return TRUE;
7024  }
7025  if (lMat->rows() != lMat->cols())
7026  {
7027    Werror("second matrix (%d x %d) is not quadratic",
7028           lMat->rows(), lMat->cols());
7029    return TRUE;
7030  }
7031  if (lMat->rows() != uMat->rows())
7032  {
7033    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7034           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7035    return TRUE;
7036  }
7037  if (uMat->rows() != bVec->rows())
7038  {
7039    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7040           uMat->rows(), uMat->cols(), bVec->rows());
7041    return TRUE;
7042  }
7043  if (!idIsConstant((ideal)pMat)
7044  ||(!idIsConstant((ideal)lMat))
7045  ||(!idIsConstant((ideal)uMat))
7046  )
7047  {
7048    WerrorS("matrices must be constant");
7049    return TRUE;
7050  }
7051  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7052
7053  /* build the return structure; a list with either one or three entries */
7054  lists ll = (lists)omAllocBin(slists_bin);
7055  if (solvable)
7056  {
7057    ll->Init(3);
7058    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7059    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7060    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7061  }
7062  else
7063  {
7064    ll->Init(1);
7065    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7066  }
7067
7068  res->data=(char*)ll;
7069  return FALSE;
7070}
7071static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7072{
7073  int i=0;
7074  leftv h=v;
7075  if (h!=NULL) i=exprlist_length(h);
7076  intvec *iv=new intvec(i);
7077  i=0;
7078  while (h!=NULL)
7079  {
7080    if(h->Typ()==INT_CMD)
7081    {
7082      (*iv)[i]=(int)(long)h->Data();
7083    }
7084    else
7085    {
7086      delete iv;
7087      return TRUE;
7088    }
7089    i++;
7090    h=h->next;
7091  }
7092  res->data=(char *)iv;
7093  return FALSE;
7094}
7095static BOOLEAN jjJET4(leftv res, leftv u)
7096{
7097  leftv u1=u;
7098  leftv u2=u1->next;
7099  leftv u3=u2->next;
7100  leftv u4=u3->next;
7101  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7102  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
7103  {
7104    if(!pIsUnit((poly)u2->Data()))
7105    {
7106      WerrorS("2nd argument must be a unit");
7107      return TRUE;
7108    }
7109    res->rtyp=u1->Typ();
7110    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7111                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7112    return FALSE;
7113  }
7114  else
7115  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7116  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
7117  {
7118    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7119    {
7120      WerrorS("2nd argument must be a diagonal matrix of units");
7121      return TRUE;
7122    }
7123    res->rtyp=u1->Typ();
7124    res->data=(char*)idSeries(
7125                              (int)(long)u3->Data(),
7126                              idCopy((ideal)u1->Data()),
7127                              mp_Copy((matrix)u2->Data(), currRing),
7128                              (intvec*)u4->Data()
7129                             );
7130    return FALSE;
7131  }
7132  else
7133  {
7134    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7135           Tok2Cmdname(iiOp));
7136    return TRUE;
7137  }
7138}
7139static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7140{
7141  if ((yyInRingConstruction)
7142  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7143  {
7144    memcpy(res,u,sizeof(sleftv));
7145    memset(u,0,sizeof(sleftv));
7146    return FALSE;
7147  }
7148  leftv v=u->next;
7149  BOOLEAN b;
7150  if(v==NULL)
7151    b=iiExprArith1(res,u,iiOp);
7152  else
7153  {
7154    u->next=NULL;
7155    b=iiExprArith2(res,u,iiOp,v);
7156    u->next=v;
7157  }
7158  return b;
7159}
7160BOOLEAN jjLIST_PL(leftv res, leftv v)
7161{
7162  int sl=0;
7163  if (v!=NULL) sl = v->listLength();
7164  lists L;
7165  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7166  {
7167    int add_row_shift = 0;
7168    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7169    if (weights!=NULL)  add_row_shift=weights->min_in();
7170    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7171  }
7172  else
7173  {
7174    L=(lists)omAllocBin(slists_bin);
7175    leftv h=NULL;
7176    int i;
7177    int rt;
7178
7179    L->Init(sl);
7180    for (i=0;i<sl;i++)
7181    {
7182      if (h!=NULL)
7183      { /* e.g. not in the first step:
7184         * h is the pointer to the old sleftv,
7185         * v is the pointer to the next sleftv
7186         * (in this moment) */
7187         h->next=v;
7188      }
7189      h=v;
7190      v=v->next;
7191      h->next=NULL;
7192      rt=h->Typ();
7193      if (rt==0)
7194      {
7195        L->Clean();
7196        Werror("`%s` is undefined",h->Fullname());
7197        return TRUE;
7198      }
7199      if ((rt==RING_CMD)||(rt==QRING_CMD))
7200      {
7201        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7202        ((ring)L->m[i].data)->ref++;
7203      }
7204      else
7205        L->m[i].Copy(h);
7206    }
7207  }
7208  res->data=(char *)L;
7209  return FALSE;
7210}
7211static BOOLEAN jjNAMES0(leftv res, leftv)
7212{
7213  res->data=(void *)ipNameList(IDROOT);
7214  return FALSE;
7215}
7216static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7217{
7218  if(v==NULL)
7219  {
7220    res->data=(char *)showOption();
7221    return FALSE;
7222  }
7223  res->rtyp=NONE;
7224  return setOption(res,v);
7225}
7226static BOOLEAN jjREDUCE4(leftv res, leftv u)
7227{
7228  leftv u1=u;
7229  leftv u2=u1->next;
7230  leftv u3=u2->next;
7231  leftv u4=u3->next;
7232  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7233  {
7234    int save_d=Kstd1_deg;
7235    Kstd1_deg=(int)(long)u3->Data();
7236    kModW=(intvec *)u4->Data();
7237    BITSET save=verbose;
7238    verbose|=Sy_bit(V_DEG_STOP);
7239    u2->next=NULL;
7240    BOOLEAN r=jjCALL2ARG(res,u);
7241    kModW=NULL;
7242    Kstd1_deg=save_d;
7243    verbose=save;
7244    u->next->next=u3;
7245    return r;
7246  }
7247  else
7248  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7249     (u4->Typ()==INT_CMD))
7250  {
7251    assumeStdFlag(u3);
7252    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7253    {
7254      WerrorS("2nd argument must be a diagonal matrix of units");
7255      return TRUE;
7256    }
7257    res->rtyp=IDEAL_CMD;
7258    res->data=(char*)redNF(
7259                           idCopy((ideal)u3->Data()),
7260                           idCopy((ideal)u1->Data()),
7261                           mp_Copy((matrix)u2->Data(), currRing),
7262                           (int)(long)u4->Data()
7263                          );
7264    return FALSE;
7265  }
7266  else
7267  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7268     (u4->Typ()==INT_CMD))
7269  {
7270    assumeStdFlag(u3);
7271    if(!pIsUnit((poly)u2->Data()))
7272    {
7273      WerrorS("2nd argument must be a unit");
7274      return TRUE;
7275    }
7276    res->rtyp=POLY_CMD;
7277    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7278                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7279    return FALSE;
7280  }
7281  else
7282  {
7283    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7284    return TRUE;
7285  }
7286}
7287static BOOLEAN jjREDUCE5(leftv res, leftv u)
7288{
7289  leftv u1=u;
7290  leftv u2=u1->next;
7291  leftv u3=u2->next;
7292  leftv u4=u3->next;
7293  leftv u5=u4->next;
7294  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7295     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7296  {
7297    assumeStdFlag(u3);
7298    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7299    {
7300      WerrorS("2nd argument must be a diagonal matrix of units");
7301      return TRUE;
7302    }
7303    res->rtyp=IDEAL_CMD;
7304    res->data=(char*)redNF(
7305                           idCopy((ideal)u3->Data()),
7306                           idCopy((ideal)u1->Data()),
7307                           mp_Copy((matrix)u2->Data(),currRing),
7308                           (int)(long)u4->Data(),
7309                           (intvec*)u5->Data()
7310                          );
7311    return FALSE;
7312  }
7313  else
7314  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7315     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7316  {
7317    assumeStdFlag(u3);
7318    if(!pIsUnit((poly)u2->Data()))
7319    {
7320      WerrorS("2nd argument must be a unit");
7321      return TRUE;
7322    }
7323    res->rtyp=POLY_CMD;
7324    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7325                           pCopy((poly)u2->Data()),
7326                           (int)(long)u4->Data(),(intvec*)u5->Data());
7327    return FALSE;
7328  }
7329  else
7330  {
7331    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7332           Tok2Cmdname(iiOp));
7333    return TRUE;
7334  }
7335}
7336static BOOLEAN jjRESERVED0(leftv, leftv)
7337{
7338  int i=1;
7339  int nCount = (sArithBase.nCmdUsed-1)/3;
7340  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7341  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7342  //      sArithBase.nCmdAllocated);
7343  for(i=0; i<nCount; i++)
7344  {
7345    Print("%-20s",sArithBase.sCmds[i+1].name);
7346    if(i+1+nCount<sArithBase.nCmdUsed)
7347      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7348    if(i+1+2*nCount<sArithBase.nCmdUsed)
7349      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7350    //if ((i%3)==1) PrintLn();
7351    PrintLn();
7352  }
7353  PrintLn();
7354  printBlackboxTypes();
7355  return FALSE;
7356}
7357static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7358{
7359  if (v == NULL)
7360  {
7361    res->data = omStrDup("");
7362    return FALSE;
7363  }
7364  int n = v->listLength();
7365  if (n == 1)
7366  {
7367    res->data = v->String();
7368    return FALSE;
7369  }
7370
7371  char** slist = (char**) omAlloc(n*sizeof(char*));
7372  int i, j;
7373
7374  for (i=0, j=0; i<n; i++, v = v ->next)
7375  {
7376    slist[i] = v->String();
7377    assume(slist[i] != NULL);
7378    j+=strlen(slist[i]);
7379  }
7380  char* s = (char*) omAlloc((j+1)*sizeof(char));
7381  *s='\0';
7382  for (i=0;i<n;i++)
7383  {
7384    strcat(s, slist[i]);
7385    omFree(slist[i]);
7386  }
7387  omFreeSize(slist, n*sizeof(char*));
7388  res->data = s;
7389  return FALSE;
7390}
7391static BOOLEAN jjTEST(leftv, leftv v)
7392{
7393  do
7394  {
7395    if (v->Typ()!=INT_CMD)
7396      return TRUE;
7397    test_cmd((int)(long)v->Data());
7398    v=v->next;
7399  }
7400  while (v!=NULL);
7401  return FALSE;
7402}
7403
7404#if defined(__alpha) && !defined(linux)
7405extern "C"
7406{
7407  void usleep(unsigned long usec);
7408};
7409#endif
7410static BOOLEAN jjFactModD_M(leftv res, leftv v)
7411{
7412  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7413     see a detailed documentation in /kernel/linearAlgebra.h
7414
7415     valid argument lists:
7416     - (poly h, int d),
7417     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7418     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7419                                                          in list of ring vars,
7420     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7421                                                optional: all 4 optional args
7422     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7423      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7424      has exactly two distinct monic factors [possibly with exponent > 1].)
7425     result:
7426     - list with the two factors f and g such that
7427       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7428
7429  poly h      = NULL;
7430  int  d      =    1;
7431  poly f0     = NULL;
7432  poly g0     = NULL;
7433  int  xIndex =    1;   /* default index if none provided */
7434  int  yIndex =    2;   /* default index if none provided */
7435
7436  leftv u = v; int factorsGiven = 0;
7437  if ((u == NULL) || (u->Typ() != POLY_CMD))
7438  {
7439    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7440    return TRUE;
7441  }
7442  else h = (poly)u->Data();
7443  u = u->next;
7444  if ((u == NULL) || (u->Typ() != INT_CMD))
7445  {
7446    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7447    return TRUE;
7448  }
7449  else d = (int)(long)u->Data();
7450  u = u->next;
7451  if ((u != NULL) && (u->Typ() == POLY_CMD))
7452  {
7453    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7454    {
7455      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7456      return TRUE;
7457    }
7458    else
7459    {
7460      f0 = (poly)u->Data();
7461      g0 = (poly)u->next->Data();
7462      factorsGiven = 1;
7463      u = u->next->next;
7464    }
7465  }
7466  if ((u != NULL) && (u->Typ() == INT_CMD))
7467  {
7468    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7469    {
7470      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7471      return TRUE;
7472    }
7473    else
7474    {
7475      xIndex = (int)(long)u->Data();
7476      yIndex = (int)(long)u->next->Data();
7477      u = u->next->next;
7478    }
7479  }
7480  if (u != NULL)
7481  {
7482    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7483    return TRUE;
7484  }
7485
7486  /* checks for provided arguments */
7487  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7488  {
7489    WerrorS("expected non-constant polynomial argument(s)");
7490    return TRUE;
7491  }
7492  int n = rVar(currRing);
7493  if ((xIndex < 1) || (n < xIndex))
7494  {
7495    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7496    return TRUE;
7497  }
7498  if ((yIndex < 1) || (n < yIndex))
7499  {
7500    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7501    return TRUE;
7502  }
7503  if (xIndex == yIndex)
7504  {
7505    WerrorS("expected distinct indices for variables x and y");
7506    return TRUE;
7507  }
7508
7509  /* computation of f0 and g0 if missing */
7510  if (factorsGiven == 0)
7511  {
7512#ifdef HAVE_FACTORY
7513    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7514    intvec* v = NULL;
7515    ideal i = singclap_factorize(h0, &v, 0,currRing);
7516
7517    ivTest(v);
7518
7519    if (i == NULL) return TRUE;
7520
7521    idTest(i);
7522
7523    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7524    {
7525      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7526      return TRUE;
7527    }
7528    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7529    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7530    idDelete(&i);
7531#else
7532    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7533    return TRUE;
7534#endif
7535  }
7536
7537  poly f; poly g;
7538  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7539  lists L = (lists)omAllocBin(slists_bin);
7540  L->Init(2);
7541  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7542  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7543  res->rtyp = LIST_CMD;
7544  res->data = (char*)L;
7545  return FALSE;
7546}
7547static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7548{
7549  if ((v->Typ() != LINK_CMD) ||
7550      (v->next->Typ() != STRING_CMD) ||
7551      (v->next->next->Typ() != STRING_CMD) ||
7552      (v->next->next->next->Typ() != INT_CMD))
7553    return TRUE;
7554  jjSTATUS3(res, v, v->next, v->next->next);
7555#if defined(HAVE_USLEEP)
7556  if (((long) res->data) == 0L)
7557  {
7558    int i_s = (int)(long) v->next->next->next->Data();
7559    if (i_s > 0)
7560    {
7561      usleep((int)(long) v->next->next->next->Data());
7562      jjSTATUS3(res, v, v->next, v->next->next);
7563    }
7564  }
7565#elif defined(HAVE_SLEEP)
7566  if (((int) res->data) == 0)
7567  {
7568    int i_s = (int) v->next->next->next->Data();
7569    if (i_s > 0)
7570    {
7571      sleep((is - 1)/1000000 + 1);
7572      jjSTATUS3(res, v, v->next, v->next->next);
7573    }
7574  }
7575#endif
7576  return FALSE;
7577}
7578static BOOLEAN jjSUBST_M(leftv res, leftv u)
7579{
7580  leftv v = u->next; // number of args > 0
7581  if (v==NULL) return TRUE;
7582  leftv w = v->next;
7583  if (w==NULL) return TRUE;
7584  leftv rest = w->next;;
7585
7586  u->next = NULL;
7587  v->next = NULL;
7588  w->next = NULL;
7589  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7590  if ((rest!=NULL) && (!b))
7591  {
7592    sleftv tmp_res;
7593    leftv tmp_next=res->next;
7594    res->next=rest;
7595    memset(&tmp_res,0,sizeof(tmp_res));
7596    b = iiExprArithM(&tmp_res,res,iiOp);
7597    memcpy(res,&tmp_res,sizeof(tmp_res));
7598    res->next=tmp_next;
7599  }
7600  u->next = v;
7601  v->next = w;
7602  // rest was w->next, but is already cleaned
7603  return b;
7604}
7605static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7606{
7607  if ((INPUT->Typ() != MATRIX_CMD) ||
7608      (INPUT->next->Typ() != NUMBER_CMD) ||
7609      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7610      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7611  {
7612    WerrorS("expected (matrix, number, number, number) as arguments");
7613    return TRUE;
7614  }
7615  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7616  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7617                                    (number)(v->Data()),
7618                                    (number)(w->Data()),
7619                                    (number)(x->Data()));
7620  return FALSE;
7621}
7622static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7623{ ideal result;
7624  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7625  leftv v = u->next;  /* one additional polynomial or ideal */
7626  leftv h = v->next;  /* Hilbert vector */
7627  leftv w = h->next;  /* weight vector */
7628  assumeStdFlag(u);
7629  ideal i1=(ideal)(u->Data());
7630  ideal i0;
7631  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7632  || (h->Typ()!=INTVEC_CMD)
7633  || (w->Typ()!=INTVEC_CMD))
7634  {
7635    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7636    return TRUE;
7637  }
7638  intvec *vw=(intvec *)w->Data(); // weights of vars
7639  /* merging std_hilb_w and std_1 */
7640  if (vw->length()!=currRing->N)
7641  {
7642    Werror("%d weights for %d variables",vw->length(),currRing->N);
7643    return TRUE;
7644  }
7645  int r=v->Typ();
7646  BOOLEAN cleanup_i0=FALSE;
7647  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7648  {
7649    i0=idInit(1,i1->rank);
7650    i0->m[0]=(poly)v->Data();
7651    BOOLEAN cleanup_i0=TRUE;
7652  }
7653  else if (r==IDEAL_CMD)/* IDEAL */
7654  {
7655    i0=(ideal)v->Data();
7656  }
7657  else
7658  {
7659    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7660    return TRUE;
7661  }
7662  int ii0=idElem(i0);
7663  i1 = idSimpleAdd(i1,i0);
7664  if (cleanup_i0)
7665  {
7666    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7667    idDelete(&i0);
7668  }
7669  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7670  tHomog hom=testHomog;
7671  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7672  if (ww!=NULL)
7673  {
7674    if (!idTestHomModule(i1,currQuotient,ww))
7675    {
7676      WarnS("wrong weights");
7677      ww=NULL;
7678    }
7679    else
7680    {
7681      ww=ivCopy(ww);
7682      hom=isHomog;
7683    }
7684  }
7685  BITSET save_test=test;
7686  test|=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  test=save_test;
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    if (at>MAX_TOK)
7747    {
7748      blackbox *bb=getBlackboxStuff(at);
7749      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7750      else          return TRUE;
7751    }
7752    int bt=b->Typ();
7753    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7754    int index=i;
7755
7756    iiOp=op;
7757    while (dArith2[i].cmd==op)
7758    {
7759      if ((at==dArith2[i].arg1)
7760      && (bt==dArith2[i].arg2))
7761      {
7762        res->rtyp=dArith2[i].res;
7763        if (currRing!=NULL)
7764        {
7765          if (check_valid(dArith2[i].valid_for,op)) break;
7766        }
7767        if (TEST_V_ALLWARN)
7768          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7769        if ((call_failed=dArith2[i].p(res,a,b)))
7770        {
7771          break;// leave loop, goto error handling
7772        }
7773        a->CleanUp();
7774        b->CleanUp();
7775        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7776        return FALSE;
7777      }
7778      i++;
7779    }
7780    // implicite type conversion ----------------------------------------------
7781    if (dArith2[i].cmd!=op)
7782    {
7783      int ai,bi;
7784      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7785      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7786      BOOLEAN failed=FALSE;
7787      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7788      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7789      while (dArith2[i].cmd==op)
7790      {
7791        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7792        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7793        {
7794          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7795          {
7796            res->rtyp=dArith2[i].res;
7797            if (currRing!=NULL)
7798            {
7799              if (check_valid(dArith2[i].valid_for,op)) break;
7800            }
7801            if (TEST_V_ALLWARN)
7802              Print("call %s(%s,%s)\n",iiTwoOps(op),
7803              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7804            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7805            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7806            || (call_failed=dArith2[i].p(res,an,bn)));
7807            // everything done, clean up temp. variables
7808            if (failed)
7809            {
7810              // leave loop, goto error handling
7811              break;
7812            }
7813            else
7814            {
7815              // everything ok, clean up and return
7816              an->CleanUp();
7817              bn->CleanUp();
7818              omFreeBin((ADDRESS)an, sleftv_bin);
7819              omFreeBin((ADDRESS)bn, sleftv_bin);
7820              a->CleanUp();
7821              b->CleanUp();
7822              return FALSE;
7823            }
7824          }
7825        }
7826        i++;
7827      }
7828      an->CleanUp();
7829      bn->CleanUp();
7830      omFreeBin((ADDRESS)an, sleftv_bin);
7831      omFreeBin((ADDRESS)bn, sleftv_bin);
7832    }
7833    // error handling ---------------------------------------------------
7834    const char *s=NULL;
7835    if (!errorreported)
7836    {
7837      if ((at==0) && (a->Fullname()!=sNoName))
7838      {
7839        s=a->Fullname();
7840      }
7841      else if ((bt==0) && (b->Fullname()!=sNoName))
7842      {
7843        s=b->Fullname();
7844      }
7845      if (s!=NULL)
7846        Werror("`%s` is not defined",s);
7847      else
7848      {
7849        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7850        s = iiTwoOps(op);
7851        if (proccall)
7852        {
7853          Werror("%s(`%s`,`%s`) failed"
7854                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7855        }
7856        else
7857        {
7858          Werror("`%s` %s `%s` failed"
7859                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7860        }
7861        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7862        {
7863          while (dArith2[i].cmd==op)
7864          {
7865            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7866            && (dArith2[i].res!=0)
7867            && (dArith2[i].p!=jjWRONG2))
7868            {
7869              if (proccall)
7870                Werror("expected %s(`%s`,`%s`)"
7871                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7872              else
7873                Werror("expected `%s` %s `%s`"
7874                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7875            }
7876            i++;
7877          }
7878        }
7879      }
7880    }
7881    res->rtyp = UNKNOWN;
7882  }
7883  a->CleanUp();
7884  b->CleanUp();
7885  return TRUE;
7886}
7887
7888/*==================== operations with 1 arg. ===============================*/
7889/* must be ordered: first operations for chars (infix ops),
7890 * then alphabetically */
7891
7892BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7893{
7894  memset(res,0,sizeof(sleftv));
7895  BOOLEAN call_failed=FALSE;
7896
7897  if (!errorreported)
7898  {
7899#ifdef SIQ
7900    if (siq>0)
7901    {
7902      //Print("siq:%d\n",siq);
7903      command d=(command)omAlloc0Bin(sip_command_bin);
7904      memcpy(&d->arg1,a,sizeof(sleftv));
7905      //a->Init();
7906      d->op=op;
7907      d->argc=1;
7908      res->data=(char *)d;
7909      res->rtyp=COMMAND;
7910      return FALSE;
7911    }
7912#endif
7913    int at=a->Typ();
7914    if (at>MAX_TOK)
7915    {
7916      blackbox *bb=getBlackboxStuff(at);
7917      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7918      else          return TRUE;
7919    }
7920
7921    BOOLEAN failed=FALSE;
7922    iiOp=op;
7923    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7924    int ti = i;
7925    while (dArith1[i].cmd==op)
7926    {
7927      if (at==dArith1[i].arg)
7928      {
7929        int r=res->rtyp=dArith1[i].res;
7930        if (currRing!=NULL)
7931        {
7932          if (check_valid(dArith1[i].valid_for,op)) break;
7933        }
7934        if (TEST_V_ALLWARN)
7935          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
7936        if (r<0)
7937        {
7938          res->rtyp=-r;
7939          #ifdef PROC_BUG
7940          dArith1[i].p(res,a);
7941          #else
7942          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7943          #endif
7944        }
7945        else if ((call_failed=dArith1[i].p(res,a)))
7946        {
7947          break;// leave loop, goto error handling
7948        }
7949        if (a->Next()!=NULL)
7950        {
7951          res->next=(leftv)omAllocBin(sleftv_bin);
7952          failed=iiExprArith1(res->next,a->next,op);
7953        }
7954        a->CleanUp();
7955        return failed;
7956      }
7957      i++;
7958    }
7959    // implicite type conversion --------------------------------------------
7960    if (dArith1[i].cmd!=op)
7961    {
7962      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7963      i=ti;
7964      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7965      while (dArith1[i].cmd==op)
7966      {
7967        int ai;
7968        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7969        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7970        {
7971          int r=res->rtyp=dArith1[i].res;
7972          if (currRing!=NULL)
7973          {
7974            if (check_valid(dArith1[i].valid_for,op)) break;
7975          }
7976          if (r<0)
7977          {
7978            res->rtyp=-r;
7979            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7980            if (!failed)
7981            {
7982              #ifdef PROC_BUG
7983              dArith1[i].p(res,a);
7984              #else
7985              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
7986              #endif
7987            }
7988          }
7989          else
7990          {
7991            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
7992            || (call_failed=dArith1[i].p(res,an)));
7993          }
7994          // everything done, clean up temp. variables
7995          if (failed)
7996          {
7997            // leave loop, goto error handling
7998            break;
7999          }
8000          else
8001          {
8002            if (TEST_V_ALLWARN)
8003              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
8004            if (an->Next() != NULL)
8005            {
8006              res->next = (leftv)omAllocBin(sleftv_bin);
8007              failed=iiExprArith1(res->next,an->next,op);
8008            }
8009            // everything ok, clean up and return
8010            an->CleanUp();
8011            omFreeBin((ADDRESS)an, sleftv_bin);
8012            a->CleanUp();
8013            return failed;
8014          }
8015        }
8016        i++;
8017      }
8018      an->CleanUp();
8019      omFreeBin((ADDRESS)an, sleftv_bin);
8020    }
8021    // error handling
8022    if (!errorreported)
8023    {
8024      if ((at==0) && (a->Fullname()!=sNoName))
8025      {
8026        Werror("`%s` is not defined",a->Fullname());
8027      }
8028      else
8029      {
8030        i=ti;
8031        const char *s = iiTwoOps(op);
8032        Werror("%s(`%s`) failed"
8033                ,s,Tok2Cmdname(at));
8034        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8035        {
8036          while (dArith1[i].cmd==op)
8037          {
8038            if ((dArith1[i].res!=0)
8039            && (dArith1[i].p!=jjWRONG))
8040              Werror("expected %s(`%s`)"
8041                ,s,Tok2Cmdname(dArith1[i].arg));
8042            i++;
8043          }
8044        }
8045      }
8046    }
8047    res->rtyp = UNKNOWN;
8048  }
8049  a->CleanUp();
8050  return TRUE;
8051}
8052
8053/*=================== operations with 3 args. ============================*/
8054/* must be ordered: first operations for chars (infix ops),
8055 * then alphabetically */
8056
8057BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8058{
8059  memset(res,0,sizeof(sleftv));
8060  BOOLEAN call_failed=FALSE;
8061
8062  if (!errorreported)
8063  {
8064#ifdef SIQ
8065    if (siq>0)
8066    {
8067      //Print("siq:%d\n",siq);
8068      command d=(command)omAlloc0Bin(sip_command_bin);
8069      memcpy(&d->arg1,a,sizeof(sleftv));
8070      //a->Init();
8071      memcpy(&d->arg2,b,sizeof(sleftv));
8072      //b->Init();
8073      memcpy(&d->arg3,c,sizeof(sleftv));
8074      //c->Init();
8075      d->op=op;
8076      d->argc=3;
8077      res->data=(char *)d;
8078      res->rtyp=COMMAND;
8079      return FALSE;
8080    }
8081#endif
8082    int at=a->Typ();
8083    if (at>MAX_TOK)
8084    {
8085      blackbox *bb=getBlackboxStuff(at);
8086      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
8087      else          return TRUE;
8088    }
8089    int bt=b->Typ();
8090    int ct=c->Typ();
8091
8092    iiOp=op;
8093    int i=0;
8094    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8095    while (dArith3[i].cmd==op)
8096    {
8097      if ((at==dArith3[i].arg1)
8098      && (bt==dArith3[i].arg2)
8099      && (ct==dArith3[i].arg3))
8100      {
8101        res->rtyp=dArith3[i].res;
8102        if (currRing!=NULL)
8103        {
8104          if (check_valid(dArith3[i].valid_for,op)) break;
8105        }
8106        if (TEST_V_ALLWARN)
8107          Print("call %s(%s,%s,%s)\n",
8108            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8109        if ((call_failed=dArith3[i].p(res,a,b,c)))
8110        {
8111          break;// leave loop, goto error handling
8112        }
8113        a->CleanUp();
8114        b->CleanUp();
8115        c->CleanUp();
8116        return FALSE;
8117      }
8118      i++;
8119    }
8120    // implicite type conversion ----------------------------------------------
8121    if (dArith3[i].cmd!=op)
8122    {
8123      int ai,bi,ci;
8124      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8125      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8126      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8127      BOOLEAN failed=FALSE;
8128      i=0;
8129      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8130      while (dArith3[i].cmd==op)
8131      {
8132        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
8133        {
8134          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
8135          {
8136            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
8137            {
8138              res->rtyp=dArith3[i].res;
8139              if (currRing!=NULL)
8140              {
8141                if (check_valid(dArith3[i].valid_for,op)) break;
8142              }
8143              if (TEST_V_ALLWARN)
8144                Print("call %s(%s,%s,%s)\n",
8145                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8146                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8147              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8148                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8149                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8150                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8151              // everything done, clean up temp. variables
8152              if (failed)
8153              {
8154                // leave loop, goto error handling
8155                break;
8156              }
8157              else
8158              {
8159                // everything ok, clean up and return
8160                an->CleanUp();
8161                bn->CleanUp();
8162                cn->CleanUp();
8163                omFreeBin((ADDRESS)an, sleftv_bin);
8164                omFreeBin((ADDRESS)bn, sleftv_bin);
8165                omFreeBin((ADDRESS)cn, sleftv_bin);
8166                a->CleanUp();
8167                b->CleanUp();
8168                c->CleanUp();
8169        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8170                return FALSE;
8171              }
8172            }
8173          }
8174        }
8175        i++;
8176      }
8177      an->CleanUp();
8178      bn->CleanUp();
8179      cn->CleanUp();
8180      omFreeBin((ADDRESS)an, sleftv_bin);
8181      omFreeBin((ADDRESS)bn, sleftv_bin);
8182      omFreeBin((ADDRESS)cn, sleftv_bin);
8183    }
8184    // error handling ---------------------------------------------------
8185    if (!errorreported)
8186    {
8187      const char *s=NULL;
8188      if ((at==0) && (a->Fullname()!=sNoName))
8189      {
8190        s=a->Fullname();
8191      }
8192      else if ((bt==0) && (b->Fullname()!=sNoName))
8193      {
8194        s=b->Fullname();
8195      }
8196      else if ((ct==0) && (c->Fullname()!=sNoName))
8197      {
8198        s=c->Fullname();
8199      }
8200      if (s!=NULL)
8201        Werror("`%s` is not defined",s);
8202      else
8203      {
8204        i=0;
8205        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8206        const char *s = iiTwoOps(op);
8207        Werror("%s(`%s`,`%s`,`%s`) failed"
8208                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8209        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8210        {
8211          while (dArith3[i].cmd==op)
8212          {
8213            if(((at==dArith3[i].arg1)
8214            ||(bt==dArith3[i].arg2)
8215            ||(ct==dArith3[i].arg3))
8216            && (dArith3[i].res!=0))
8217            {
8218              Werror("expected %s(`%s`,`%s`,`%s`)"
8219                  ,s,Tok2Cmdname(dArith3[i].arg1)
8220                  ,Tok2Cmdname(dArith3[i].arg2)
8221                  ,Tok2Cmdname(dArith3[i].arg3));
8222            }
8223            i++;
8224          }
8225        }
8226      }
8227    }
8228    res->rtyp = UNKNOWN;
8229  }
8230  a->CleanUp();
8231  b->CleanUp();
8232  c->CleanUp();
8233        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8234  return TRUE;
8235}
8236/*==================== operations with many arg. ===============================*/
8237/* must be ordered: first operations for chars (infix ops),
8238 * then alphabetically */
8239
8240BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8241{
8242  // cnt = 0: all
8243  // cnt = 1: only first one
8244  leftv next;
8245  BOOLEAN failed = TRUE;
8246  if(v==NULL) return failed;
8247  res->rtyp = LIST_CMD;
8248  if(cnt) v->next = NULL;
8249  next = v->next;             // saving next-pointer
8250  failed = jjLIST_PL(res, v);
8251  v->next = next;             // writeback next-pointer
8252  return failed;
8253}
8254
8255BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8256{
8257  memset(res,0,sizeof(sleftv));
8258
8259  if (!errorreported)
8260  {
8261#ifdef SIQ
8262    if (siq>0)
8263    {
8264      //Print("siq:%d\n",siq);
8265      command d=(command)omAlloc0Bin(sip_command_bin);
8266      d->op=op;
8267      res->data=(char *)d;
8268      if (a!=NULL)
8269      {
8270        d->argc=a->listLength();
8271        // else : d->argc=0;
8272        memcpy(&d->arg1,a,sizeof(sleftv));
8273        switch(d->argc)
8274        {
8275          case 3:
8276            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8277            a->next->next->Init();
8278            /* no break */
8279          case 2:
8280            memcpy(&d->arg2,a->next,sizeof(sleftv));
8281            a->next->Init();
8282            a->next->next=d->arg2.next;
8283            d->arg2.next=NULL;
8284            /* no break */
8285          case 1:
8286            a->Init();
8287            a->next=d->arg1.next;
8288            d->arg1.next=NULL;
8289        }
8290        if (d->argc>3) a->next=NULL;
8291        a->name=NULL;
8292        a->rtyp=0;
8293        a->data=NULL;
8294        a->e=NULL;
8295        a->attribute=NULL;
8296        a->CleanUp();
8297      }
8298      res->rtyp=COMMAND;
8299      return FALSE;
8300    }
8301#endif
8302    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8303    {
8304      blackbox *bb=getBlackboxStuff(a->Typ());
8305      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8306      else          return TRUE;
8307    }
8308    BOOLEAN failed=FALSE;
8309    int args=0;
8310    if (a!=NULL) args=a->listLength();
8311
8312    iiOp=op;
8313    int i=0;
8314    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8315    while (dArithM[i].cmd==op)
8316    {
8317      if ((args==dArithM[i].number_of_args)
8318      || (dArithM[i].number_of_args==-1)
8319      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8320      {
8321        res->rtyp=dArithM[i].res;
8322        if (currRing!=NULL)
8323        {
8324          if (check_valid(dArithM[i].valid_for,op)) break;
8325        }
8326        if (TEST_V_ALLWARN)
8327          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8328        if (dArithM[i].p(res,a))
8329        {
8330          break;// leave loop, goto error handling
8331        }
8332        if (a!=NULL) a->CleanUp();
8333        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8334        return failed;
8335      }
8336      i++;
8337    }
8338    // error handling
8339    if (!errorreported)
8340    {
8341      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8342      {
8343        Werror("`%s` is not defined",a->Fullname());
8344      }
8345      else
8346      {
8347        const char *s = iiTwoOps(op);
8348        Werror("%s(...) failed",s);
8349      }
8350    }
8351    res->rtyp = UNKNOWN;
8352  }
8353  if (a!=NULL) a->CleanUp();
8354        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8355  return TRUE;
8356}
8357
8358/*=================== general utilities ============================*/
8359int IsCmd(const char *n, int & tok)
8360{
8361  int i;
8362  int an=1;
8363  int en=sArithBase.nLastIdentifier;
8364
8365  loop
8366  //for(an=0; an<sArithBase.nCmdUsed; )
8367  {
8368    if(an>=en-1)
8369    {
8370      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8371      {
8372        i=an;
8373        break;
8374      }
8375      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8376      {
8377        i=en;
8378        break;
8379      }
8380      else
8381      {
8382        // -- blackbox extensions:
8383        // return 0;
8384        return blackboxIsCmd(n,tok);
8385      }
8386    }
8387    i=(an+en)/2;
8388    if (*n < *(sArithBase.sCmds[i].name))
8389    {
8390      en=i-1;
8391    }
8392    else if (*n > *(sArithBase.sCmds[i].name))
8393    {
8394      an=i+1;
8395    }
8396    else
8397    {
8398      int v=strcmp(n,sArithBase.sCmds[i].name);
8399      if(v<0)
8400      {
8401        en=i-1;
8402      }
8403      else if(v>0)
8404      {
8405        an=i+1;
8406      }
8407      else /*v==0*/
8408      {
8409        break;
8410      }
8411    }
8412  }
8413  lastreserved=sArithBase.sCmds[i].name;
8414  tok=sArithBase.sCmds[i].tokval;
8415  if(sArithBase.sCmds[i].alias==2)
8416  {
8417    Warn("outdated identifier `%s` used - please change your code",
8418    sArithBase.sCmds[i].name);
8419    sArithBase.sCmds[i].alias=1;
8420  }
8421  if (currRingHdl==NULL)
8422  {
8423    #ifdef SIQ
8424    if (siq<=0)
8425    {
8426    #endif
8427      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8428      {
8429        WerrorS("no ring active");
8430        return 0;
8431      }
8432    #ifdef SIQ
8433    }
8434    #endif
8435  }
8436  if (!expected_parms)
8437  {
8438    switch (tok)
8439    {
8440      case IDEAL_CMD:
8441      case INT_CMD:
8442      case INTVEC_CMD:
8443      case MAP_CMD:
8444      case MATRIX_CMD:
8445      case MODUL_CMD:
8446      case POLY_CMD:
8447      case PROC_CMD:
8448      case RING_CMD:
8449      case STRING_CMD:
8450        cmdtok = tok;
8451        break;
8452    }
8453  }
8454  return sArithBase.sCmds[i].toktype;
8455}
8456static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8457{
8458  // user defined types are not in the pre-computed table:
8459  if (op>MAX_TOK) return 0;
8460
8461  int a=0;
8462  int e=len;
8463  int p=len/2;
8464  do
8465  {
8466     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8467     if (op<dArithTab[p].cmd) e=p-1;
8468     else   a = p+1;
8469     p=a+(e-a)/2;
8470  }
8471  while ( a <= e);
8472
8473  // catch missing a cmd:
8474  assume(0);
8475  return 0;
8476}
8477
8478const char * Tok2Cmdname(int tok)
8479{
8480  int i = 0;
8481  if (tok <= 0)
8482  {
8483    return sArithBase.sCmds[0].name;
8484  }
8485  if (tok==ANY_TYPE) return "any_type";
8486  if (tok==COMMAND) return "command";
8487  if (tok==NONE) return "nothing";
8488  //if (tok==IFBREAK) return "if_break";
8489  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8490  //if (tok==ORDER_VECTOR) return "ordering";
8491  //if (tok==REF_VAR) return "ref";
8492  //if (tok==OBJECT) return "object";
8493  //if (tok==PRINT_EXPR) return "print_expr";
8494  if (tok==IDHDL) return "identifier";
8495  if (tok>MAX_TOK) return getBlackboxName(tok);
8496  for(i=0; i<sArithBase.nCmdUsed; i++)
8497    //while (sArithBase.sCmds[i].tokval!=0)
8498  {
8499    if ((sArithBase.sCmds[i].tokval == tok)&&
8500        (sArithBase.sCmds[i].alias==0))
8501    {
8502      return sArithBase.sCmds[i].name;
8503    }
8504  }
8505  return sArithBase.sCmds[0].name;
8506}
8507
8508
8509/*---------------------------------------------------------------------*/
8510/**
8511 * @brief compares to entry of cmdsname-list
8512
8513 @param[in] a
8514 @param[in] b
8515
8516 @return <ReturnValue>
8517**/
8518/*---------------------------------------------------------------------*/
8519static int _gentable_sort_cmds( const void *a, const void *b )
8520{
8521  cmdnames *pCmdL = (cmdnames*)a;
8522  cmdnames *pCmdR = (cmdnames*)b;
8523
8524  if(a==NULL || b==NULL)             return 0;
8525
8526  /* empty entries goes to the end of the list for later reuse */
8527  if(pCmdL->name==NULL) return 1;
8528  if(pCmdR->name==NULL) return -1;
8529
8530  /* $INVALID$ must come first */
8531  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8532  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8533
8534  /* tokval=-1 are reserved names at the end */
8535  if (pCmdL->tokval==-1)
8536  {
8537    if (pCmdR->tokval==-1)
8538       return strcmp(pCmdL->name, pCmdR->name);
8539    /* pCmdL->tokval==-1, pCmdL goes at the end */
8540    return 1;
8541  }
8542  /* pCmdR->tokval==-1, pCmdR goes at the end */
8543  if(pCmdR->tokval==-1) return -1;
8544
8545  return strcmp(pCmdL->name, pCmdR->name);
8546}
8547
8548/*---------------------------------------------------------------------*/
8549/**
8550 * @brief initialisation of arithmetic structured data
8551
8552 @retval 0 on success
8553
8554**/
8555/*---------------------------------------------------------------------*/
8556int iiInitArithmetic()
8557{
8558  //printf("iiInitArithmetic()\n");
8559  memset(&sArithBase, 0, sizeof(sArithBase));
8560  iiInitCmdName();
8561  /* fix last-identifier */
8562#if 0
8563  /* we expect that gentable allready did every thing */
8564  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8565      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8566    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8567  }
8568#endif
8569  //Print("L=%d\n", sArithBase.nLastIdentifier);
8570
8571  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8572  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8573
8574  //iiArithAddCmd("Top", 0,-1,0);
8575
8576
8577  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8578  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8579  //         sArithBase.sCmds[i].name,
8580  //         sArithBase.sCmds[i].alias,
8581  //         sArithBase.sCmds[i].tokval,
8582  //         sArithBase.sCmds[i].toktype);
8583  //}
8584  //iiArithRemoveCmd("Top");
8585  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8586  //iiArithRemoveCmd("mygcd");
8587  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8588  return 0;
8589}
8590
8591int iiArithFindCmd(const char *szName)
8592{
8593  int an=0;
8594  int i = 0,v = 0;
8595  int en=sArithBase.nLastIdentifier;
8596
8597  loop
8598  //for(an=0; an<sArithBase.nCmdUsed; )
8599  {
8600    if(an>=en-1)
8601    {
8602      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8603      {
8604        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8605        return an;
8606      }
8607      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8608      {
8609        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8610        return en;
8611      }
8612      else
8613      {
8614        //Print("RET- 1\n");
8615        return -1;
8616      }
8617    }
8618    i=(an+en)/2;
8619    if (*szName < *(sArithBase.sCmds[i].name))
8620    {
8621      en=i-1;
8622    }
8623    else if (*szName > *(sArithBase.sCmds[i].name))
8624    {
8625      an=i+1;
8626    }
8627    else
8628    {
8629      v=strcmp(szName,sArithBase.sCmds[i].name);
8630      if(v<0)
8631      {
8632        en=i-1;
8633      }
8634      else if(v>0)
8635      {
8636        an=i+1;
8637      }
8638      else /*v==0*/
8639      {
8640        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8641        return i;
8642      }
8643    }
8644  }
8645  //if(i>=0 && i<sArithBase.nCmdUsed)
8646  //  return i;
8647  //Print("RET-2\n");
8648  return -2;
8649}
8650
8651char *iiArithGetCmd( int nPos )
8652{
8653  if(nPos<0) return NULL;
8654  if(nPos<sArithBase.nCmdUsed)
8655    return sArithBase.sCmds[nPos].name;
8656  return NULL;
8657}
8658
8659int iiArithRemoveCmd(const char *szName)
8660{
8661  int nIndex;
8662  if(szName==NULL) return -1;
8663
8664  nIndex = iiArithFindCmd(szName);
8665  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8666  {
8667    Print("'%s' not found (%d)\n", szName, nIndex);
8668    return -1;
8669  }
8670  omFree(sArithBase.sCmds[nIndex].name);
8671  sArithBase.sCmds[nIndex].name=NULL;
8672  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8673        (&_gentable_sort_cmds));
8674  sArithBase.nCmdUsed--;
8675
8676  /* fix last-identifier */
8677  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8678      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8679  {
8680    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8681  }
8682  //Print("L=%d\n", sArithBase.nLastIdentifier);
8683  return 0;
8684}
8685
8686int iiArithAddCmd(
8687  const char *szName,
8688  short nAlias,
8689  short nTokval,
8690  short nToktype,
8691  short nPos
8692  )
8693{
8694  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8695  //       nTokval, nToktype, nPos);
8696  if(nPos>=0)
8697  {
8698    // no checks: we rely on a correct generated code in iparith.inc
8699    assume(nPos < sArithBase.nCmdAllocated);
8700    assume(szName!=NULL);
8701    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8702    sArithBase.sCmds[nPos].alias   = nAlias;
8703    sArithBase.sCmds[nPos].tokval  = nTokval;
8704    sArithBase.sCmds[nPos].toktype = nToktype;
8705    sArithBase.nCmdUsed++;
8706    //if(nTokval>0) sArithBase.nLastIdentifier++;
8707  }
8708  else
8709  {
8710    if(szName==NULL) return -1;
8711    int nIndex = iiArithFindCmd(szName);
8712    if(nIndex>=0)
8713    {
8714      Print("'%s' already exists at %d\n", szName, nIndex);
8715      return -1;
8716    }
8717
8718    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8719    {
8720      /* needs to create new slots */
8721      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8722      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8723      if(sArithBase.sCmds==NULL) return -1;
8724      sArithBase.nCmdAllocated++;
8725    }
8726    /* still free slots available */
8727    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8728    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8729    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8730    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8731    sArithBase.nCmdUsed++;
8732
8733    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8734          (&_gentable_sort_cmds));
8735    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8736        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8737    {
8738      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8739    }
8740    //Print("L=%d\n", sArithBase.nLastIdentifier);
8741  }
8742  return 0;
8743}
8744
8745static BOOLEAN check_valid(const int p, const int op)
8746{
8747  #ifdef HAVE_PLURAL
8748  if (rIsPluralRing(currRing))
8749  {
8750    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8751    {
8752      WerrorS("not implemented for non-commutative rings");
8753      return TRUE;
8754    }
8755    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8756    {
8757      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8758      return FALSE;
8759    }
8760    /* else, ALLOW_PLURAL */
8761  }
8762  #endif
8763  #ifdef HAVE_RINGS
8764  if (rField_is_Ring(currRing))
8765  {
8766    if ((p & RING_MASK)==0 /*NO_RING*/)
8767    {
8768      WerrorS("not implemented for rings with rings as coeffients");
8769      return TRUE;
8770    }
8771    /* else ALLOW_RING */
8772    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8773    &&(!rField_is_Domain(currRing)))
8774    {
8775      WerrorS("domain required as coeffients");
8776      return TRUE;
8777    }
8778    /* else ALLOW_ZERODIVISOR */
8779  }
8780  #endif
8781  return FALSE;
8782}
Note: See TracBrowser for help on using the repository browser.