source: git/Singular/iparith.cc @ cd4f24

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