source: git/Singular/iparith.cc @ 228e0b

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