source: git/Singular/iparith.cc @ 23a78e

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