source: git/Singular/iparith.cc @ 74757f8

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