source: git/Singular/iparith.cc @ 36b81ac

spielwiese
Last change on this file since 36b81ac was ede2ad8, checked in by Hans Schoenemann <hannes@…>, 9 years ago
fix tr. #712: std(SB,I) does not allow crit3 because of the (wrong) order of reductions if size(I)*4 > 3*size(SB), use std(SB+I), otherwise disable crit3
  • Property mode set to 100644
File size: 225.5 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 jjBI2P(leftv res, leftv u)
3790{
3791  sleftv tmp;
3792  BOOLEAN bo=jjBI2N(&tmp,u);
3793  if (!bo)
3794  {
3795    number n=(number) tmp.data;
3796    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3797    else
3798    {
3799      res->data=(void *)pNSet(n);
3800    }
3801  }
3802  return bo;
3803}
3804static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3805{
3806  return iiExprArithM(res,u,iiOp);
3807}
3808static BOOLEAN jjCHAR(leftv res, leftv v)
3809{
3810  res->data = (char *)(long)rChar((ring)v->Data());
3811  return FALSE;
3812}
3813static BOOLEAN jjCOLS(leftv res, leftv v)
3814{
3815  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3816  return FALSE;
3817}
3818static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3819{
3820  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3821  return FALSE;
3822}
3823static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3824{
3825  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3826  return FALSE;
3827}
3828static BOOLEAN jjCONTENT(leftv res, leftv v)
3829{
3830  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3831  poly p=(poly)v->CopyD(POLY_CMD);
3832  if (p!=NULL) p_Cleardenom(p, currRing);
3833  res->data = (char *)p;
3834  return FALSE;
3835}
3836static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3837{
3838  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3839  return FALSE;
3840}
3841static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3842{
3843  res->data = (char *)(long)nSize((number)v->Data());
3844  return FALSE;
3845}
3846static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3847{
3848  lists l=(lists)v->Data();
3849  res->data = (char *)(long)(lSize(l)+1);
3850  return FALSE;
3851}
3852static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3853{
3854  matrix m=(matrix)v->Data();
3855  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3856  return FALSE;
3857}
3858static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3859{
3860  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3861  return FALSE;
3862}
3863static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3864{
3865  ring r=(ring)v->Data();
3866  int elems=-1;
3867  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3868  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3869  {
3870    extern int ipower ( int b, int n ); /* factory/cf_util */
3871    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3872  }
3873  res->data = (char *)(long)elems;
3874  return FALSE;
3875}
3876static BOOLEAN jjDEG(leftv res, leftv v)
3877{
3878  int dummy;
3879  poly p=(poly)v->Data();
3880  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3881  else res->data=(char *)-1;
3882  return FALSE;
3883}
3884static BOOLEAN jjDEG_M(leftv res, leftv u)
3885{
3886  ideal I=(ideal)u->Data();
3887  int d=-1;
3888  int dummy;
3889  int i;
3890  for(i=IDELEMS(I)-1;i>=0;i--)
3891    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3892  res->data = (char *)(long)d;
3893  return FALSE;
3894}
3895static BOOLEAN jjDEGREE(leftv res, leftv v)
3896{
3897  SPrintStart();
3898#ifdef HAVE_RINGS
3899  if (rField_is_Ring_Z(currRing))
3900  {
3901    ring origR = currRing;
3902    ring tempR = rCopy(origR);
3903    coeffs new_cf=nInitChar(n_Q,NULL);
3904    nKillChar(tempR->cf);
3905    tempR->cf=new_cf;
3906    rComplete(tempR);
3907    ideal vid = (ideal)v->Data();
3908    rChangeCurrRing(tempR);
3909    ideal vv = idrCopyR(vid, origR, currRing);
3910    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3911    vvAsLeftv.rtyp = IDEAL_CMD;
3912    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3913    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3914    assumeStdFlag(&vvAsLeftv);
3915    Print("// NOTE: computation of degree is being performed for\n");
3916    Print("//       generic fibre, that is, over Q\n");
3917    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3918    scDegree(vv,module_w,currRing->qideal);
3919    idDelete(&vv);
3920    rChangeCurrRing(origR);
3921    rDelete(tempR);
3922  }
3923#endif
3924  assumeStdFlag(v);
3925  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3926  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3927  char *s=SPrintEnd();
3928  int l=strlen(s)-1;
3929  s[l]='\0';
3930  res->data=(void*)s;
3931  return FALSE;
3932}
3933static BOOLEAN jjDEFINED(leftv res, leftv v)
3934{
3935  if ((v->rtyp==IDHDL)
3936  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3937  {
3938    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3939  }
3940  else if (v->rtyp!=0) res->data=(void *)(-1);
3941  return FALSE;
3942}
3943
3944/// Return the denominator of the input number
3945/// NOTE: the input number is normalized as a side effect
3946static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3947{
3948  number n = reinterpret_cast<number>(v->Data());
3949  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3950  return FALSE;
3951}
3952
3953/// Return the numerator of the input number
3954/// NOTE: the input number is normalized as a side effect
3955static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3956{
3957  number n = reinterpret_cast<number>(v->Data());
3958  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3959  return FALSE;
3960}
3961
3962static BOOLEAN jjDET(leftv res, leftv v)
3963{
3964  matrix m=(matrix)v->Data();
3965  poly p;
3966  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3967  {
3968    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3969    p=sm_CallDet(I, currRing);
3970    idDelete(&I);
3971  }
3972  else
3973    p=singclap_det(m,currRing);
3974  res ->data = (char *)p;
3975  return FALSE;
3976}
3977static BOOLEAN jjDET_BI(leftv res, leftv v)
3978{
3979  bigintmat * m=(bigintmat*)v->Data();
3980  int i,j;
3981  i=m->rows();j=m->cols();
3982  if(i==j)
3983    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3984  else
3985  {
3986    Werror("det of %d x %d bigintmat",i,j);
3987    return TRUE;
3988  }
3989  return FALSE;
3990}
3991static BOOLEAN jjDET_I(leftv res, leftv v)
3992{
3993  intvec * m=(intvec*)v->Data();
3994  int i,j;
3995  i=m->rows();j=m->cols();
3996  if(i==j)
3997    res->data = (char *)(long)singclap_det_i(m,currRing);
3998  else
3999  {
4000    Werror("det of %d x %d intmat",i,j);
4001    return TRUE;
4002  }
4003  return FALSE;
4004}
4005static BOOLEAN jjDET_S(leftv res, leftv v)
4006{
4007  ideal I=(ideal)v->Data();
4008  poly p;
4009  if (IDELEMS(I)<1) return TRUE;
4010  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
4011  {
4012    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
4013    p=singclap_det(m,currRing);
4014    idDelete((ideal *)&m);
4015  }
4016  else
4017    p=sm_CallDet(I, currRing);
4018  res->data = (char *)p;
4019  return FALSE;
4020}
4021static BOOLEAN jjDIM(leftv res, leftv v)
4022{
4023  assumeStdFlag(v);
4024#ifdef HAVE_RINGS
4025  if (rField_is_Ring(currRing))
4026  {
4027    //ring origR = currRing;
4028    //ring tempR = rCopy(origR);
4029    //coeffs new_cf=nInitChar(n_Q,NULL);
4030    //nKillChar(tempR->cf);
4031    //tempR->cf=new_cf;
4032    //rComplete(tempR);
4033    ideal vid = (ideal)v->Data();
4034    int i = idPosConstant(vid);
4035    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4036    { /* ideal v contains unit; dim = -1 */
4037      res->data = (char *)-1;
4038      return FALSE;
4039    }
4040    //rChangeCurrRing(tempR);
4041    //ideal vv = idrCopyR(vid, origR, currRing);
4042    ideal vv = id_Head(vid,currRing);
4043    /* drop degree zero generator from vv (if any) */
4044    if (i != -1) pDelete(&vv->m[i]);
4045    long d = (long)scDimInt(vv, currRing->qideal);
4046    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
4047    res->data = (char *)d;
4048    idDelete(&vv);
4049    //rChangeCurrRing(origR);
4050    //rDelete(tempR);
4051    return FALSE;
4052  }
4053#endif
4054  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4055  return FALSE;
4056}
4057static BOOLEAN jjDUMP(leftv, leftv v)
4058{
4059  si_link l = (si_link)v->Data();
4060  if (slDump(l))
4061  {
4062    const char *s;
4063    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4064    else                            s=sNoName;
4065    Werror("cannot dump to `%s`",s);
4066    return TRUE;
4067  }
4068  else
4069    return FALSE;
4070}
4071static BOOLEAN jjE(leftv res, leftv v)
4072{
4073  res->data = (char *)pOne();
4074  int co=(int)(long)v->Data();
4075  if (co>0)
4076  {
4077    pSetComp((poly)res->data,co);
4078    pSetm((poly)res->data);
4079  }
4080  else WerrorS("argument of gen must be positive");
4081  return (co<=0);
4082}
4083static BOOLEAN jjEXECUTE(leftv, leftv v)
4084{
4085  char * d = (char *)v->Data();
4086  char * s = (char *)omAlloc(strlen(d) + 13);
4087  strcpy( s, (char *)d);
4088  strcat( s, "\n;RETURN();\n");
4089  newBuffer(s,BT_execute);
4090  return yyparse();
4091}
4092static BOOLEAN jjFACSTD(leftv res, leftv v)
4093{
4094  lists L=(lists)omAllocBin(slists_bin);
4095  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4096  {
4097    ideal_list p,h;
4098    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4099    if (h==NULL)
4100    {
4101      L->Init(1);
4102      L->m[0].data=(char *)idInit(1);
4103      L->m[0].rtyp=IDEAL_CMD;
4104    }
4105    else
4106    {
4107      p=h;
4108      int l=0;
4109      while (p!=NULL) { p=p->next;l++; }
4110      L->Init(l);
4111      l=0;
4112      while(h!=NULL)
4113      {
4114        L->m[l].data=(char *)h->d;
4115        L->m[l].rtyp=IDEAL_CMD;
4116        p=h->next;
4117        omFreeSize(h,sizeof(*h));
4118        h=p;
4119        l++;
4120      }
4121    }
4122  }
4123  else
4124  {
4125    WarnS("no factorization implemented");
4126    L->Init(1);
4127    iiExprArith1(&(L->m[0]),v,STD_CMD);
4128  }
4129  res->data=(void *)L;
4130  return FALSE;
4131}
4132static BOOLEAN jjFAC_P(leftv res, leftv u)
4133{
4134  intvec *v=NULL;
4135  singclap_factorize_retry=0;
4136  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4137  if (f==NULL) return TRUE;
4138  ivTest(v);
4139  lists l=(lists)omAllocBin(slists_bin);
4140  l->Init(2);
4141  l->m[0].rtyp=IDEAL_CMD;
4142  l->m[0].data=(void *)f;
4143  l->m[1].rtyp=INTVEC_CMD;
4144  l->m[1].data=(void *)v;
4145  res->data=(void *)l;
4146  return FALSE;
4147}
4148static BOOLEAN jjGETDUMP(leftv, leftv v)
4149{
4150  si_link l = (si_link)v->Data();
4151  if (slGetDump(l))
4152  {
4153    const char *s;
4154    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4155    else                            s=sNoName;
4156    Werror("cannot get dump from `%s`",s);
4157    return TRUE;
4158  }
4159  else
4160    return FALSE;
4161}
4162static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4163{
4164  assumeStdFlag(v);
4165  ideal I=(ideal)v->Data();
4166  res->data=(void *)iiHighCorner(I,0);
4167  return FALSE;
4168}
4169static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4170{
4171  assumeStdFlag(v);
4172  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4173  BOOLEAN delete_w=FALSE;
4174  ideal I=(ideal)v->Data();
4175  int i;
4176  poly p=NULL,po=NULL;
4177  int rk=id_RankFreeModule(I,currRing);
4178  if (w==NULL)
4179  {
4180    w = new intvec(rk);
4181    delete_w=TRUE;
4182  }
4183  for(i=rk;i>0;i--)
4184  {
4185    p=iiHighCorner(I,i);
4186    if (p==NULL)
4187    {
4188      WerrorS("module must be zero-dimensional");
4189      if (delete_w) delete w;
4190      return TRUE;
4191    }
4192    if (po==NULL)
4193    {
4194      po=p;
4195    }
4196    else
4197    {
4198      // now po!=NULL, p!=NULL
4199      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4200      if (d==0)
4201        d=pLmCmp(po,p);
4202      if (d > 0)
4203      {
4204        pDelete(&p);
4205      }
4206      else // (d < 0)
4207      {
4208        pDelete(&po); po=p;
4209      }
4210    }
4211  }
4212  if (delete_w) delete w;
4213  res->data=(void *)po;
4214  return FALSE;
4215}
4216static BOOLEAN jjHILBERT(leftv, leftv v)
4217{
4218#ifdef HAVE_RINGS
4219  if (rField_is_Ring_Z(currRing))
4220  {
4221    ring origR = currRing;
4222    ring tempR = rCopy(origR);
4223    coeffs new_cf=nInitChar(n_Q,NULL);
4224    nKillChar(tempR->cf);
4225    tempR->cf=new_cf;
4226    rComplete(tempR);
4227    ideal vid = (ideal)v->Data();
4228    rChangeCurrRing(tempR);
4229    ideal vv = idrCopyR(vid, origR, currRing);
4230    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4231    vvAsLeftv.rtyp = IDEAL_CMD;
4232    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4233    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4234    assumeStdFlag(&vvAsLeftv);
4235    Print("// NOTE: computation of Hilbert series etc. is being\n");
4236    Print("//       performed for generic fibre, that is, over Q\n");
4237    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4238    //scHilbertPoly(vv,currRing->qideal);
4239    hLookSeries(vv,module_w,currRing->qideal);
4240    idDelete(&vv);
4241    rChangeCurrRing(origR);
4242    rDelete(tempR);
4243    return FALSE;
4244  }
4245#endif
4246  assumeStdFlag(v);
4247  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4248  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4249  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4250  return FALSE;
4251}
4252static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4253{
4254#ifdef HAVE_RINGS
4255  if (rField_is_Ring_Z(currRing))
4256  {
4257    Print("// NOTE: computation of Hilbert series etc. is being\n");
4258    Print("//       performed for generic fibre, that is, over Q\n");
4259  }
4260#endif
4261  res->data=(void *)hSecondSeries((intvec *)v->Data());
4262  return FALSE;
4263}
4264static BOOLEAN jjHOMOG1(leftv res, leftv v)
4265{
4266  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4267  ideal v_id=(ideal)v->Data();
4268  if (w==NULL)
4269  {
4270    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4271    if (res->data!=NULL)
4272    {
4273      if (v->rtyp==IDHDL)
4274      {
4275        char *s_isHomog=omStrDup("isHomog");
4276        if (v->e==NULL)
4277          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4278        else
4279          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4280      }
4281      else if (w!=NULL) delete w;
4282    } // if res->data==NULL then w==NULL
4283  }
4284  else
4285  {
4286    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4287    if((res->data==NULL) && (v->rtyp==IDHDL))
4288    {
4289      if (v->e==NULL)
4290        atKill((idhdl)(v->data),"isHomog");
4291      else
4292        atKill((idhdl)(v->LData()),"isHomog");
4293    }
4294  }
4295  return FALSE;
4296}
4297static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4298{
4299  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4300  setFlag(res,FLAG_STD);
4301  return FALSE;
4302}
4303static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4304{
4305  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4306  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4307  if (IDELEMS((ideal)mat)==0)
4308  {
4309    idDelete((ideal *)&mat);
4310    mat=(matrix)idInit(1,1);
4311  }
4312  else
4313  {
4314    MATROWS(mat)=1;
4315    mat->rank=1;
4316    idTest((ideal)mat);
4317  }
4318  res->data=(char *)mat;
4319  return FALSE;
4320}
4321static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4322{
4323  map m=(map)v->CopyD(MAP_CMD);
4324  omFree((ADDRESS)m->preimage);
4325  m->preimage=NULL;
4326  ideal I=(ideal)m;
4327  I->rank=1;
4328  res->data=(char *)I;
4329  return FALSE;
4330}
4331static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4332{
4333  if (currRing!=NULL)
4334  {
4335    ring q=(ring)v->Data();
4336    if (rSamePolyRep(currRing, q))
4337    {
4338      if (q->qideal==NULL)
4339        res->data=(char *)idInit(1,1);
4340      else
4341        res->data=(char *)idCopy(q->qideal);
4342      return FALSE;
4343    }
4344  }
4345  WerrorS("can only get ideal from identical qring");
4346  return TRUE;
4347}
4348static BOOLEAN jjIm2Iv(leftv res, leftv v)
4349{
4350  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4351  iv->makeVector();
4352  res->data = iv;
4353  return FALSE;
4354}
4355static BOOLEAN jjIMPART(leftv res, leftv v)
4356{
4357  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4358  return FALSE;
4359}
4360static BOOLEAN jjINDEPSET(leftv res, leftv v)
4361{
4362  assumeStdFlag(v);
4363  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4364  return FALSE;
4365}
4366static BOOLEAN jjINTERRED(leftv res, leftv v)
4367{
4368  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4369  #ifdef HAVE_RINGS
4370  if(rField_is_Ring(currRing))
4371    Warn("interred: this command is experimental over the integers");
4372  #endif
4373  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4374  res->data = result;
4375  return FALSE;
4376}
4377static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4378{
4379  res->data = (char *)(long)pVar((poly)v->Data());
4380  return FALSE;
4381}
4382static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4383{
4384  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4385                                                            currRing->N)+1);
4386  return FALSE;
4387}
4388static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4389{
4390  res->data = (char *)0;
4391  return FALSE;
4392}
4393static BOOLEAN jjJACOB_P(leftv res, leftv v)
4394{
4395  ideal i=idInit(currRing->N,1);
4396  int k;
4397  poly p=(poly)(v->Data());
4398  for (k=currRing->N;k>0;k--)
4399  {
4400    i->m[k-1]=pDiff(p,k);
4401  }
4402  res->data = (char *)i;
4403  return FALSE;
4404}
4405static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4406{
4407  if (!nCoeff_is_transExt(currRing->cf))
4408  {
4409    WerrorS("differentiation not defined in the coefficient ring");
4410    return TRUE;
4411  }
4412  number n = (number) u->Data();
4413  number k = (number) v->Data();
4414  res->data = ntDiff(n,k,currRing->cf);
4415  return FALSE;
4416}
4417/*2
4418 * compute Jacobi matrix of a module/matrix
4419 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4420 * where Mt := transpose(M)
4421 * Note that this is consistent with the current conventions for jacob in Singular,
4422 * whereas M2 computes its transposed.
4423 */
4424static BOOLEAN jjJACOB_M(leftv res, leftv a)
4425{
4426  ideal id = (ideal)a->Data();
4427  id = idTransp(id);
4428  int W = IDELEMS(id);
4429
4430  ideal result = idInit(W * currRing->N, id->rank);
4431  poly *p = result->m;
4432
4433  for( int v = 1; v <= currRing->N; v++ )
4434  {
4435    poly* q = id->m;
4436    for( int i = 0; i < W; i++, p++, q++ )
4437      *p = pDiff( *q, v );
4438  }
4439  idDelete(&id);
4440
4441  res->data = (char *)result;
4442  return FALSE;
4443}
4444
4445
4446static BOOLEAN jjKBASE(leftv res, leftv v)
4447{
4448  assumeStdFlag(v);
4449  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4450  return FALSE;
4451}
4452static BOOLEAN jjL2R(leftv res, leftv v)
4453{
4454  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4455  if (res->data != NULL)
4456    return FALSE;
4457  else
4458    return TRUE;
4459}
4460static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4461{
4462  poly p=(poly)v->Data();
4463  if (p==NULL)
4464  {
4465    res->data=(char *)nInit(0);
4466  }
4467  else
4468  {
4469    res->data=(char *)nCopy(pGetCoeff(p));
4470  }
4471  return FALSE;
4472}
4473static BOOLEAN jjLEADEXP(leftv res, leftv v)
4474{
4475  poly p=(poly)v->Data();
4476  int s=currRing->N;
4477  if (v->Typ()==VECTOR_CMD) s++;
4478  intvec *iv=new intvec(s);
4479  if (p!=NULL)
4480  {
4481    for(int i = currRing->N;i;i--)
4482    {
4483      (*iv)[i-1]=pGetExp(p,i);
4484    }
4485    if (s!=currRing->N)
4486      (*iv)[currRing->N]=pGetComp(p);
4487  }
4488  res->data=(char *)iv;
4489  return FALSE;
4490}
4491static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4492{
4493  poly p=(poly)v->Data();
4494  if (p == NULL)
4495  {
4496    res->data = (char*) NULL;
4497  }
4498  else
4499  {
4500    poly lm = pLmInit(p);
4501    pSetCoeff(lm, nInit(1));
4502    res->data = (char*) lm;
4503  }
4504  return FALSE;
4505}
4506static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4507{
4508  return jjLOAD((char*)v->Data(),FALSE);
4509}
4510static BOOLEAN jjLISTRING(leftv res, leftv v)
4511{
4512  ring r=rCompose((lists)v->Data());
4513  if (r==NULL) return TRUE;
4514  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4515  res->data=(char *)r;
4516  return FALSE;
4517}
4518static BOOLEAN jjPFAC1(leftv res, leftv v)
4519{
4520  /* call method jjPFAC2 with second argument = 0 (meaning that no
4521     valid bound for the prime factors has been given) */
4522  sleftv tmp;
4523  memset(&tmp, 0, sizeof(tmp));
4524  tmp.rtyp = INT_CMD;
4525  return jjPFAC2(res, v, &tmp);
4526}
4527static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4528{
4529  /* computes the LU-decomposition of a matrix M;
4530     i.e., M = P * L * U, where
4531        - P is a row permutation matrix,
4532        - L is in lower triangular form,
4533        - U is in upper row echelon form
4534     Then, we also have P * M = L * U.
4535     A list [P, L, U] is returned. */
4536  matrix mat = (const matrix)v->Data();
4537  if (!idIsConstant((ideal)mat))
4538  {
4539    WerrorS("matrix must be constant");
4540    return TRUE;
4541  }
4542  matrix pMat;
4543  matrix lMat;
4544  matrix uMat;
4545
4546  luDecomp(mat, pMat, lMat, uMat);
4547
4548  lists ll = (lists)omAllocBin(slists_bin);
4549  ll->Init(3);
4550  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4551  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4552  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4553  res->data=(char*)ll;
4554
4555  return FALSE;
4556}
4557static BOOLEAN jjMEMORY(leftv res, leftv v)
4558{
4559  omUpdateInfo();
4560  switch(((int)(long)v->Data()))
4561  {
4562  case 0:
4563    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4564    break;
4565  case 1:
4566    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4567    break;
4568  case 2:
4569    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4570    break;
4571  default:
4572    omPrintStats(stdout);
4573    omPrintInfo(stdout);
4574    omPrintBinStats(stdout);
4575    res->data = (char *)0;
4576    res->rtyp = NONE;
4577  }
4578  return FALSE;
4579  res->data = (char *)0;
4580  return FALSE;
4581}
4582//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4583//{
4584//  return jjMONITOR2(res,v,NULL);
4585//}
4586static BOOLEAN jjMSTD(leftv res, leftv v)
4587{
4588  int t=v->Typ();
4589  ideal r,m;
4590  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4591  lists l=(lists)omAllocBin(slists_bin);
4592  l->Init(2);
4593  l->m[0].rtyp=t;
4594  l->m[0].data=(char *)r;
4595  setFlag(&(l->m[0]),FLAG_STD);
4596  l->m[1].rtyp=t;
4597  l->m[1].data=(char *)m;
4598  res->data=(char *)l;
4599  return FALSE;
4600}
4601static BOOLEAN jjMULT(leftv res, leftv v)
4602{
4603  assumeStdFlag(v);
4604  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4605  return FALSE;
4606}
4607static BOOLEAN jjMINRES_R(leftv res, leftv v)
4608{
4609  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4610
4611  syStrategy tmp=(syStrategy)v->Data();
4612  tmp = syMinimize(tmp); // enrich itself!
4613
4614  res->data=(char *)tmp;
4615
4616  if (weights!=NULL)
4617    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4618
4619  return FALSE;
4620}
4621static BOOLEAN jjN2BI(leftv res, leftv v)
4622{
4623  number n,i; i=(number)v->Data();
4624  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4625  if (nMap!=NULL)
4626    n=nMap(i,currRing->cf,coeffs_BIGINT);
4627  else goto err;
4628  res->data=(void *)n;
4629  return FALSE;
4630err:
4631  WerrorS("cannot convert to bigint"); return TRUE;
4632}
4633static BOOLEAN jjNAMEOF(leftv res, leftv v)
4634{
4635  res->data = (char *)v->name;
4636  if (res->data==NULL) res->data=omStrDup("");
4637  v->name=NULL;
4638  return FALSE;
4639}
4640static BOOLEAN jjNAMES(leftv res, leftv v)
4641{
4642  res->data=ipNameList(((ring)v->Data())->idroot);
4643  return FALSE;
4644}
4645static BOOLEAN jjNAMES_I(leftv res, leftv v)
4646{
4647  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4648  return FALSE;
4649}
4650static BOOLEAN jjNOT(leftv res, leftv v)
4651{
4652  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4653  return FALSE;
4654}
4655static BOOLEAN jjNVARS(leftv res, leftv v)
4656{
4657  res->data = (char *)(long)(((ring)(v->Data()))->N);
4658  return FALSE;
4659}
4660static BOOLEAN jjOpenClose(leftv, leftv v)
4661{
4662  si_link l=(si_link)v->Data();
4663  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4664  else                return slClose(l);
4665}
4666static BOOLEAN jjORD(leftv res, leftv v)
4667{
4668  poly p=(poly)v->Data();
4669  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4670  return FALSE;
4671}
4672static BOOLEAN jjPAR1(leftv res, leftv v)
4673{
4674  int i=(int)(long)v->Data();
4675  int p=0;
4676  p=rPar(currRing);
4677  if ((0<i) && (i<=p))
4678  {
4679    res->data=(char *)n_Param(i,currRing);
4680  }
4681  else
4682  {
4683    Werror("par number %d out of range 1..%d",i,p);
4684    return TRUE;
4685  }
4686  return FALSE;
4687}
4688static BOOLEAN jjPARDEG(leftv res, leftv v)
4689{
4690  number nn=(number)v->Data();
4691  res->data = (char *)(long)n_ParDeg(nn, currRing);
4692  return FALSE;
4693}
4694static BOOLEAN jjPARSTR1(leftv res, leftv v)
4695{
4696  if (currRing==NULL)
4697  {
4698    WerrorS("no ring active");
4699    return TRUE;
4700  }
4701  int i=(int)(long)v->Data();
4702  int p=0;
4703  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4704    res->data=omStrDup(rParameter(currRing)[i-1]);
4705  else
4706  {
4707    Werror("par number %d out of range 1..%d",i,p);
4708    return TRUE;
4709  }
4710  return FALSE;
4711}
4712static BOOLEAN jjP2BI(leftv res, leftv v)
4713{
4714  poly p=(poly)v->Data();
4715  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4716  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4717  {
4718    WerrorS("poly must be constant");
4719    return TRUE;
4720  }
4721  number i=pGetCoeff(p);
4722  number n;
4723  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4724  if (nMap!=NULL)
4725    n=nMap(i,currRing->cf,coeffs_BIGINT);
4726  else goto err;
4727  res->data=(void *)n;
4728  return FALSE;
4729err:
4730  WerrorS("cannot convert to bigint"); return TRUE;
4731}
4732static BOOLEAN jjP2I(leftv res, leftv v)
4733{
4734  poly p=(poly)v->Data();
4735  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4736  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4737  {
4738    WerrorS("poly must be constant");
4739    return TRUE;
4740  }
4741  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4742  return FALSE;
4743}
4744static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4745{
4746  map mapping=(map)v->Data();
4747  syMake(res,omStrDup(mapping->preimage));
4748  return FALSE;
4749}
4750static BOOLEAN jjPRIME(leftv res, leftv v)
4751{
4752  int i = IsPrime((int)(long)(v->Data()));
4753  res->data = (char *)(long)(i > 1 ? i : 2);
4754  return FALSE;
4755}
4756static BOOLEAN jjPRUNE(leftv res, leftv v)
4757{
4758  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4759  ideal v_id=(ideal)v->Data();
4760  if (w!=NULL)
4761  {
4762    if (!idTestHomModule(v_id,currRing->qideal,w))
4763    {
4764      WarnS("wrong weights");
4765      w=NULL;
4766      // and continue at the non-homog case below
4767    }
4768    else
4769    {
4770      w=ivCopy(w);
4771      intvec **ww=&w;
4772      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4773      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4774      return FALSE;
4775    }
4776  }
4777  res->data = (char *)idMinEmbedding(v_id);
4778  return FALSE;
4779}
4780static BOOLEAN jjP2N(leftv res, leftv v)
4781{
4782  number n;
4783  poly p;
4784  if (((p=(poly)v->Data())!=NULL)
4785  && (pIsConstant(p)))
4786  {
4787    n=nCopy(pGetCoeff(p));
4788  }
4789  else
4790  {
4791    n=nInit(0);
4792  }
4793  res->data = (char *)n;
4794  return FALSE;
4795}
4796static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4797{
4798  char *s= (char *)v->Data();
4799  int i = 1;
4800  for(i=0; i<sArithBase.nCmdUsed; i++)
4801  {
4802    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4803    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4804    {
4805      res->data = (char *)1;
4806      return FALSE;
4807    }
4808  }
4809  //res->data = (char *)0;
4810  return FALSE;
4811}
4812static BOOLEAN jjRANK1(leftv res, leftv v)
4813{
4814  matrix m =(matrix)v->Data();
4815  int rank = luRank(m, 0);
4816  res->data =(char *)(long)rank;
4817  return FALSE;
4818}
4819static BOOLEAN jjREAD(leftv res, leftv v)
4820{
4821  return jjREAD2(res,v,NULL);
4822}
4823static BOOLEAN jjREGULARITY(leftv res, leftv v)
4824{
4825  res->data = (char *)(long)iiRegularity((lists)v->Data());
4826  return FALSE;
4827}
4828static BOOLEAN jjREPART(leftv res, leftv v)
4829{
4830  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4831  return FALSE;
4832}
4833static BOOLEAN jjRINGLIST(leftv res, leftv v)
4834{
4835  ring r=(ring)v->Data();
4836  if (r!=NULL)
4837    res->data = (char *)rDecompose((ring)v->Data());
4838  return (r==NULL)||(res->data==NULL);
4839}
4840static BOOLEAN jjROWS(leftv res, leftv v)
4841{
4842  ideal i = (ideal)v->Data();
4843  res->data = (char *)i->rank;
4844  return FALSE;
4845}
4846static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4847{
4848  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4849  return FALSE;
4850}
4851static BOOLEAN jjROWS_IV(leftv res, leftv v)
4852{
4853  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4854  return FALSE;
4855}
4856static BOOLEAN jjRPAR(leftv res, leftv v)
4857{
4858  res->data = (char *)(long)rPar(((ring)v->Data()));
4859  return FALSE;
4860}
4861static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4862{
4863#ifdef HAVE_PLURAL
4864  const bool bIsSCA = rIsSCA(currRing);
4865#else
4866  const bool bIsSCA = false;
4867#endif
4868
4869  if ((currRing->qideal!=NULL) && !bIsSCA)
4870  {
4871    WerrorS("qring not supported by slimgb at the moment");
4872    return TRUE;
4873  }
4874  if (rHasLocalOrMixedOrdering_currRing())
4875  {
4876    WerrorS("ordering must be global for slimgb");
4877    return TRUE;
4878  }
4879  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4880  // tHomog hom=testHomog;
4881  ideal u_id=(ideal)u->Data();
4882  if (w!=NULL)
4883  {
4884    if (!idTestHomModule(u_id,currRing->qideal,w))
4885    {
4886      WarnS("wrong weights");
4887      w=NULL;
4888    }
4889    else
4890    {
4891      w=ivCopy(w);
4892      // hom=isHomog;
4893    }
4894  }
4895
4896  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4897  res->data=(char *)t_rep_gb(currRing,
4898    u_id,u_id->rank);
4899  //res->data=(char *)t_rep_gb(currRing, u_id);
4900
4901  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4902  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4903  return FALSE;
4904}
4905static BOOLEAN jjSBA(leftv res, leftv v)
4906{
4907  ideal result;
4908  ideal v_id=(ideal)v->Data();
4909  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4910  tHomog hom=testHomog;
4911  if (w!=NULL)
4912  {
4913    if (!idTestHomModule(v_id,currRing->qideal,w))
4914    {
4915      WarnS("wrong weights");
4916      w=NULL;
4917    }
4918    else
4919    {
4920      hom=isHomog;
4921      w=ivCopy(w);
4922    }
4923  }
4924  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4925  idSkipZeroes(result);
4926  res->data = (char *)result;
4927  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4928  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4929  return FALSE;
4930}
4931static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4932{
4933  ideal result;
4934  ideal v_id=(ideal)v->Data();
4935  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4936  tHomog hom=testHomog;
4937  if (w!=NULL)
4938  {
4939    if (!idTestHomModule(v_id,currRing->qideal,w))
4940    {
4941      WarnS("wrong weights");
4942      w=NULL;
4943    }
4944    else
4945    {
4946      hom=isHomog;
4947      w=ivCopy(w);
4948    }
4949  }
4950  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4951  idSkipZeroes(result);
4952  res->data = (char *)result;
4953  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4954  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4955  return FALSE;
4956}
4957static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4958{
4959  ideal result;
4960  ideal v_id=(ideal)v->Data();
4961  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4962  tHomog hom=testHomog;
4963  if (w!=NULL)
4964  {
4965    if (!idTestHomModule(v_id,currRing->qideal,w))
4966    {
4967      WarnS("wrong weights");
4968      w=NULL;
4969    }
4970    else
4971    {
4972      hom=isHomog;
4973      w=ivCopy(w);
4974    }
4975  }
4976  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4977  idSkipZeroes(result);
4978  res->data = (char *)result;
4979  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4980  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4981  return FALSE;
4982}
4983static BOOLEAN jjSTD(leftv res, leftv v)
4984{
4985  ideal result;
4986  ideal v_id=(ideal)v->Data();
4987  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4988  tHomog hom=testHomog;
4989  if (w!=NULL)
4990  {
4991    if (!idTestHomModule(v_id,currRing->qideal,w))
4992    {
4993      WarnS("wrong weights");
4994      w=NULL;
4995    }
4996    else
4997    {
4998      hom=isHomog;
4999      w=ivCopy(w);
5000    }
5001  }
5002  result=kStd(v_id,currRing->qideal,hom,&w);
5003  idSkipZeroes(result);
5004  res->data = (char *)result;
5005  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5006  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5007  return FALSE;
5008}
5009static BOOLEAN jjSort_Id(leftv res, leftv v)
5010{
5011  res->data = (char *)idSort((ideal)v->Data());
5012  return FALSE;
5013}
5014static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5015{
5016  singclap_factorize_retry=0;
5017  intvec *v=NULL;
5018  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5019  if (f==NULL) return TRUE;
5020  ivTest(v);
5021  lists l=(lists)omAllocBin(slists_bin);
5022  l->Init(2);
5023  l->m[0].rtyp=IDEAL_CMD;
5024  l->m[0].data=(void *)f;
5025  l->m[1].rtyp=INTVEC_CMD;
5026  l->m[1].data=(void *)v;
5027  res->data=(void *)l;
5028  return FALSE;
5029}
5030#if 1
5031static BOOLEAN jjSYZYGY(leftv res, leftv v)
5032{
5033  intvec *w=NULL;
5034  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5035  if (w!=NULL) delete w;
5036  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5037  return FALSE;
5038}
5039#else
5040// activate, if idSyz handle module weights correctly !
5041static BOOLEAN jjSYZYGY(leftv res, leftv v)
5042{
5043  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5044  ideal v_id=(ideal)v->Data();
5045  tHomog hom=testHomog;
5046  int add_row_shift=0;
5047  if (w!=NULL)
5048  {
5049    w=ivCopy(w);
5050    add_row_shift=w->min_in();
5051    (*w)-=add_row_shift;
5052    if (idTestHomModule(v_id,currRing->qideal,w))
5053      hom=isHomog;
5054    else
5055    {
5056      //WarnS("wrong weights");
5057      delete w; w=NULL;
5058      hom=testHomog;
5059    }
5060  }
5061  res->data = (char *)idSyzygies(v_id,hom,&w);
5062  if (w!=NULL)
5063  {
5064    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5065  }
5066  return FALSE;
5067}
5068#endif
5069static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5070{
5071  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5072  return FALSE;
5073}
5074static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5075{
5076  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5077  return FALSE;
5078}
5079static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5080{
5081  res->data = (char *)ivTranp((intvec*)(v->Data()));
5082  return FALSE;
5083}
5084#ifdef HAVE_PLURAL
5085static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5086{
5087  ring    r = (ring)a->Data();
5088  //if (rIsPluralRing(r))
5089  if (r->OrdSgn==1)
5090  {
5091    res->data = rOpposite(r);
5092  }
5093  else
5094  {
5095    WarnS("opposite only for global orderings");
5096    res->data = rCopy(r);
5097  }
5098  return FALSE;
5099}
5100static BOOLEAN jjENVELOPE(leftv res, leftv a)
5101{
5102  ring    r = (ring)a->Data();
5103  if (rIsPluralRing(r))
5104  {
5105    //    ideal   i;
5106//     if (a->rtyp == QRING_CMD)
5107//     {
5108//       i = r->qideal;
5109//       r->qideal = NULL;
5110//     }
5111    ring s = rEnvelope(r);
5112//     if (a->rtyp == QRING_CMD)
5113//     {
5114//       ideal is  = idOppose(r,i); /* twostd? */
5115//       is        = idAdd(is,i);
5116//       s->qideal = i;
5117//     }
5118    res->data = s;
5119  }
5120  else  res->data = rCopy(r);
5121  return FALSE;
5122}
5123static BOOLEAN jjTWOSTD(leftv res, leftv a)
5124{
5125  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5126  else  res->data=(ideal)a->CopyD();
5127  setFlag(res,FLAG_STD);
5128  setFlag(res,FLAG_TWOSTD);
5129  return FALSE;
5130}
5131#endif
5132
5133static BOOLEAN jjTYPEOF(leftv res, leftv v)
5134{
5135  int t=(int)(long)v->data;
5136  switch (t)
5137  {
5138    case CRING_CMD:
5139    case INT_CMD:
5140    case POLY_CMD:
5141    case VECTOR_CMD:
5142    case STRING_CMD:
5143    case INTVEC_CMD:
5144    case IDEAL_CMD:
5145    case MATRIX_CMD:
5146    case MODUL_CMD:
5147    case MAP_CMD:
5148    case PROC_CMD:
5149    case RING_CMD:
5150    case QRING_CMD:
5151    case INTMAT_CMD:
5152    case BIGINTMAT_CMD:
5153    case NUMBER_CMD:
5154    #ifdef SINGULAR_4_1
5155    case CNUMBER_CMD:
5156    #endif
5157    case BIGINT_CMD:
5158    case LIST_CMD:
5159    case PACKAGE_CMD:
5160    case LINK_CMD:
5161    case RESOLUTION_CMD:
5162         res->data=omStrDup(Tok2Cmdname(t)); break;
5163    case DEF_CMD:
5164    case NONE:           res->data=omStrDup("none"); break;
5165    default:
5166    {
5167      if (t>MAX_TOK)
5168        res->data=omStrDup(getBlackboxName(t));
5169      else
5170        res->data=omStrDup("?unknown type?");
5171      break;
5172    }
5173  }
5174  return FALSE;
5175}
5176static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5177{
5178  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5179  return FALSE;
5180}
5181static BOOLEAN jjVAR1(leftv res, leftv v)
5182{
5183  int i=(int)(long)v->Data();
5184  if ((0<i) && (i<=currRing->N))
5185  {
5186    poly p=pOne();
5187    pSetExp(p,i,1);
5188    pSetm(p);
5189    res->data=(char *)p;
5190  }
5191  else
5192  {
5193    Werror("var number %d out of range 1..%d",i,currRing->N);
5194    return TRUE;
5195  }
5196  return FALSE;
5197}
5198static BOOLEAN jjVARSTR1(leftv res, leftv v)
5199{
5200  if (currRing==NULL)
5201  {
5202    WerrorS("no ring active");
5203    return TRUE;
5204  }
5205  int i=(int)(long)v->Data();
5206  if ((0<i) && (i<=currRing->N))
5207    res->data=omStrDup(currRing->names[i-1]);
5208  else
5209  {
5210    Werror("var number %d out of range 1..%d",i,currRing->N);
5211    return TRUE;
5212  }
5213  return FALSE;
5214}
5215static BOOLEAN jjVDIM(leftv res, leftv v)
5216{
5217  assumeStdFlag(v);
5218  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5219  return FALSE;
5220}
5221BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5222{
5223// input: u: a list with links of type
5224//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5225// returns: -1:  the read state of all links is eof
5226//          i>0: (at least) u[i] is ready
5227  lists Lforks = (lists)u->Data();
5228  int i = slStatusSsiL(Lforks, -1);
5229  if(i == -2) /* error */
5230  {
5231    return TRUE;
5232  }
5233  res->data = (void*)(long)i;
5234  return FALSE;
5235}
5236BOOLEAN jjWAITALL1(leftv res, leftv u)
5237{
5238// input: u: a list with links of type
5239//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5240// returns: -1: the read state of all links is eof
5241//           1: all links are ready
5242//              (caution: at least one is ready, but some maybe dead)
5243  lists Lforks = (lists)u->CopyD();
5244  int i;
5245  int j = -1;
5246  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5247  {
5248    i = slStatusSsiL(Lforks, -1);
5249    if(i == -2) /* error */
5250    {
5251      return TRUE;
5252    }
5253    if(i == -1)
5254    {
5255      break;
5256    }
5257    j = 1;
5258    Lforks->m[i-1].CleanUp();
5259    Lforks->m[i-1].rtyp=DEF_CMD;
5260    Lforks->m[i-1].data=NULL;
5261  }
5262  res->data = (void*)(long)j;
5263  Lforks->Clean();
5264  return FALSE;
5265}
5266
5267BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5268{
5269  char libnamebuf[256];
5270  lib_types LT = type_of_LIB(s, libnamebuf);
5271
5272#ifdef HAVE_DYNAMIC_LOADING
5273  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5274#endif /* HAVE_DYNAMIC_LOADING */
5275  switch(LT)
5276  {
5277      default:
5278      case LT_NONE:
5279        Werror("%s: unknown type", s);
5280        break;
5281      case LT_NOTFOUND:
5282        Werror("cannot open %s", s);
5283        break;
5284
5285      case LT_SINGULAR:
5286      {
5287        char *plib = iiConvName(s);
5288        idhdl pl = IDROOT->get(plib,0);
5289        if (pl==NULL)
5290        {
5291          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5292          IDPACKAGE(pl)->language = LANG_SINGULAR;
5293          IDPACKAGE(pl)->libname=omStrDup(plib);
5294        }
5295        else if (IDTYP(pl)!=PACKAGE_CMD)
5296        {
5297          Werror("can not create package `%s`",plib);
5298          omFree(plib);
5299          return TRUE;
5300        }
5301        package savepack=currPack;
5302        currPack=IDPACKAGE(pl);
5303        IDPACKAGE(pl)->loaded=TRUE;
5304        char libnamebuf[256];
5305        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5306        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5307        currPack=savepack;
5308        IDPACKAGE(pl)->loaded=(!bo);
5309        return bo;
5310      }
5311      case LT_BUILTIN:
5312        SModulFunc_t iiGetBuiltinModInit(const char*);
5313        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5314      case LT_MACH_O:
5315      case LT_ELF:
5316      case LT_HPUX:
5317#ifdef HAVE_DYNAMIC_LOADING
5318        return load_modules(s, libnamebuf, autoexport);
5319#else /* HAVE_DYNAMIC_LOADING */
5320        WerrorS("Dynamic modules are not supported by this version of Singular");
5321        break;
5322#endif /* HAVE_DYNAMIC_LOADING */
5323  }
5324  return TRUE;
5325}
5326static int WerrorS_dummy_cnt=0;
5327static void WerrorS_dummy(const char *)
5328{
5329  WerrorS_dummy_cnt++;
5330}
5331BOOLEAN jjLOAD_TRY(const char *s)
5332{
5333  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5334  WerrorS_callback=WerrorS_dummy;
5335  WerrorS_dummy_cnt=0;
5336  BOOLEAN bo=jjLOAD(s,TRUE);
5337  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5338    Print("loading of >%s< failed\n",s);
5339  WerrorS_callback=WerrorS_save;
5340  errorreported=0;
5341  return FALSE;
5342}
5343
5344static BOOLEAN jjstrlen(leftv res, leftv v)
5345{
5346  res->data = (char *)strlen((char *)v->Data());
5347  return FALSE;
5348}
5349static BOOLEAN jjpLength(leftv res, leftv v)
5350{
5351  res->data = (char *)(long)pLength((poly)v->Data());
5352  return FALSE;
5353}
5354static BOOLEAN jjidElem(leftv res, leftv v)
5355{
5356  res->data = (char *)(long)idElem((ideal)v->Data());
5357  return FALSE;
5358}
5359static BOOLEAN jjidFreeModule(leftv res, leftv v)
5360{
5361  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5362  return FALSE;
5363}
5364static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5365{
5366  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5367  return FALSE;
5368}
5369static BOOLEAN jjrCharStr(leftv res, leftv v)
5370{
5371#ifdef SINGULAR_4_1
5372  iiReWrite("charstr");
5373#endif
5374  res->data = rCharStr((ring)v->Data());
5375  return FALSE;
5376}
5377static BOOLEAN jjpHead(leftv res, leftv v)
5378{
5379  res->data = (char *)pHead((poly)v->Data());
5380  return FALSE;
5381}
5382static BOOLEAN jjidHead(leftv res, leftv v)
5383{
5384  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5385  setFlag(res,FLAG_STD);
5386  return FALSE;
5387}
5388static BOOLEAN jjidMinBase(leftv res, leftv v)
5389{
5390  res->data = (char *)idMinBase((ideal)v->Data());
5391  return FALSE;
5392}
5393static BOOLEAN jjsyMinBase(leftv res, leftv v)
5394{
5395  res->data = (char *)syMinBase((ideal)v->Data());
5396  return FALSE;
5397}
5398static BOOLEAN jjpMaxComp(leftv res, leftv v)
5399{
5400  res->data = (char *)pMaxComp((poly)v->Data());
5401  return FALSE;
5402}
5403static BOOLEAN jjmpTrace(leftv res, leftv v)
5404{
5405  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5406  return FALSE;
5407}
5408static BOOLEAN jjmpTransp(leftv res, leftv v)
5409{
5410  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5411  return FALSE;
5412}
5413static BOOLEAN jjrOrdStr(leftv res, leftv v)
5414{
5415#ifdef SINGULAR_4_1
5416  iiReWrite("ordstr");
5417#endif
5418  res->data = rOrdStr((ring)v->Data());
5419  return FALSE;
5420}
5421static BOOLEAN jjrVarStr(leftv res, leftv v)
5422{
5423#ifdef SINGULAR_4_1
5424  iiReWrite("varstr");
5425#endif
5426  res->data = rVarStr((ring)v->Data());
5427  return FALSE;
5428}
5429static BOOLEAN jjrParStr(leftv res, leftv v)
5430{
5431#ifdef SINGULAR_4_1
5432  iiReWrite("varstr");
5433#endif
5434  res->data = rParStr((ring)v->Data());
5435  return FALSE;
5436}
5437static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5438{
5439  res->data=(char *)(long)sySize((syStrategy)v->Data());
5440  return FALSE;
5441}
5442static BOOLEAN jjDIM_R(leftv res, leftv v)
5443{
5444  res->data = (char *)(long)syDim((syStrategy)v->Data());
5445  return FALSE;
5446}
5447static BOOLEAN jjidTransp(leftv res, leftv v)
5448{
5449  res->data = (char *)idTransp((ideal)v->Data());
5450  return FALSE;
5451}
5452static BOOLEAN jjnInt(leftv res, leftv u)
5453{
5454  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5455  res->data=(char *)(long)iin_Int(n,currRing->cf);
5456  n_Delete(&n,currRing->cf);
5457  return FALSE;
5458}
5459static BOOLEAN jjnlInt(leftv res, leftv u)
5460{
5461  number n=(number)u->Data();
5462  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5463  return FALSE;
5464}
5465/*=================== operations with 3 args.: static proc =================*/
5466/* must be ordered: first operations for chars (infix ops),
5467 * then alphabetically */
5468static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5469{
5470  char *s= (char *)u->Data();
5471  int   r = (int)(long)v->Data();
5472  int   c = (int)(long)w->Data();
5473  int l = strlen(s);
5474
5475  if ( (r<1) || (r>l) || (c<0) )
5476  {
5477    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5478    return TRUE;
5479  }
5480  res->data = (char *)omAlloc((long)(c+1));
5481  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5482  return FALSE;
5483}
5484static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5485{
5486  intvec *iv = (intvec *)u->Data();
5487  int   r = (int)(long)v->Data();
5488  int   c = (int)(long)w->Data();
5489  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5490  {
5491    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5492           r,c,u->Fullname(),iv->rows(),iv->cols());
5493    return TRUE;
5494  }
5495  res->data=u->data; u->data=NULL;
5496  res->rtyp=u->rtyp; u->rtyp=0;
5497  res->name=u->name; u->name=NULL;
5498  Subexpr e=jjMakeSub(v);
5499          e->next=jjMakeSub(w);
5500  if (u->e==NULL) res->e=e;
5501  else
5502  {
5503    Subexpr h=u->e;
5504    while (h->next!=NULL) h=h->next;
5505    h->next=e;
5506    res->e=u->e;
5507    u->e=NULL;
5508  }
5509  return FALSE;
5510}
5511static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5512{
5513  bigintmat *bim = (bigintmat *)u->Data();
5514  int   r = (int)(long)v->Data();
5515  int   c = (int)(long)w->Data();
5516  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5517  {
5518    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5519           r,c,u->Fullname(),bim->rows(),bim->cols());
5520    return TRUE;
5521  }
5522  res->data=u->data; u->data=NULL;
5523  res->rtyp=u->rtyp; u->rtyp=0;
5524  res->name=u->name; u->name=NULL;
5525  Subexpr e=jjMakeSub(v);
5526          e->next=jjMakeSub(w);
5527  if (u->e==NULL)
5528    res->e=e;
5529  else
5530  {
5531    Subexpr h=u->e;
5532    while (h->next!=NULL) h=h->next;
5533    h->next=e;
5534    res->e=u->e;
5535    u->e=NULL;
5536  }
5537  return FALSE;
5538}
5539static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5540{
5541  matrix m= (matrix)u->Data();
5542  int   r = (int)(long)v->Data();
5543  int   c = (int)(long)w->Data();
5544  //Print("gen. elem %d, %d\n",r,c);
5545  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5546  {
5547    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5548      MATROWS(m),MATCOLS(m));
5549    return TRUE;
5550  }
5551  res->data=u->data; u->data=NULL;
5552  res->rtyp=u->rtyp; u->rtyp=0;
5553  res->name=u->name; u->name=NULL;
5554  Subexpr e=jjMakeSub(v);
5555          e->next=jjMakeSub(w);
5556  if (u->e==NULL)
5557    res->e=e;
5558  else
5559  {
5560    Subexpr h=u->e;
5561    while (h->next!=NULL) h=h->next;
5562    h->next=e;
5563    res->e=u->e;
5564    u->e=NULL;
5565  }
5566  return FALSE;
5567}
5568static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5569{
5570  sleftv t;
5571  sleftv ut;
5572  leftv p=NULL;
5573  intvec *iv=(intvec *)w->Data();
5574  int l;
5575  BOOLEAN nok;
5576
5577  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5578  {
5579    WerrorS("cannot build expression lists from unnamed objects");
5580    return TRUE;
5581  }
5582  memcpy(&ut,u,sizeof(ut));
5583  memset(&t,0,sizeof(t));
5584  t.rtyp=INT_CMD;
5585  for (l=0;l< iv->length(); l++)
5586  {
5587    t.data=(char *)(long)((*iv)[l]);
5588    if (p==NULL)
5589    {
5590      p=res;
5591    }
5592    else
5593    {
5594      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5595      p=p->next;
5596    }
5597    memcpy(u,&ut,sizeof(ut));
5598    if (u->Typ() == MATRIX_CMD)
5599      nok=jjBRACK_Ma(p,u,v,&t);
5600    else if (u->Typ() == BIGINTMAT_CMD)
5601      nok=jjBRACK_Bim(p,u,v,&t);
5602    else /* INTMAT_CMD */
5603      nok=jjBRACK_Im(p,u,v,&t);
5604    if (nok)
5605    {
5606      while (res->next!=NULL)
5607      {
5608        p=res->next->next;
5609        omFreeBin((ADDRESS)res->next, sleftv_bin);
5610        // res->e aufraeumen !!!!
5611        res->next=p;
5612      }
5613      return TRUE;
5614    }
5615  }
5616  return FALSE;
5617}
5618static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5619{
5620  sleftv t;
5621  sleftv ut;
5622  leftv p=NULL;
5623  intvec *iv=(intvec *)v->Data();
5624  int l;
5625  BOOLEAN nok;
5626
5627  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5628  {
5629    WerrorS("cannot build expression lists from unnamed objects");
5630    return TRUE;
5631  }
5632  memcpy(&ut,u,sizeof(ut));
5633  memset(&t,0,sizeof(t));
5634  t.rtyp=INT_CMD;
5635  for (l=0;l< iv->length(); l++)
5636  {
5637    t.data=(char *)(long)((*iv)[l]);
5638    if (p==NULL)
5639    {
5640      p=res;
5641    }
5642    else
5643    {
5644      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5645      p=p->next;
5646    }
5647    memcpy(u,&ut,sizeof(ut));
5648    if (u->Typ() == MATRIX_CMD)
5649      nok=jjBRACK_Ma(p,u,&t,w);
5650    else if (u->Typ() == BIGINTMAT_CMD)
5651      nok=jjBRACK_Bim(p,u,&t,w);
5652    else /* INTMAT_CMD */
5653      nok=jjBRACK_Im(p,u,&t,w);
5654    if (nok)
5655    {
5656      while (res->next!=NULL)
5657      {
5658        p=res->next->next;
5659        omFreeBin((ADDRESS)res->next, sleftv_bin);
5660        // res->e aufraeumen !!
5661        res->next=p;
5662      }
5663      return TRUE;
5664    }
5665  }
5666  return FALSE;
5667}
5668static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5669{
5670  sleftv t1,t2,ut;
5671  leftv p=NULL;
5672  intvec *vv=(intvec *)v->Data();
5673  intvec *wv=(intvec *)w->Data();
5674  int vl;
5675  int wl;
5676  BOOLEAN nok;
5677
5678  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5679  {
5680    WerrorS("cannot build expression lists from unnamed objects");
5681    return TRUE;
5682  }
5683  memcpy(&ut,u,sizeof(ut));
5684  memset(&t1,0,sizeof(sleftv));
5685  memset(&t2,0,sizeof(sleftv));
5686  t1.rtyp=INT_CMD;
5687  t2.rtyp=INT_CMD;
5688  for (vl=0;vl< vv->length(); vl++)
5689  {
5690    t1.data=(char *)(long)((*vv)[vl]);
5691    for (wl=0;wl< wv->length(); wl++)
5692    {
5693      t2.data=(char *)(long)((*wv)[wl]);
5694      if (p==NULL)
5695      {
5696        p=res;
5697      }
5698      else
5699      {
5700        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5701        p=p->next;
5702      }
5703      memcpy(u,&ut,sizeof(ut));
5704      if (u->Typ() == MATRIX_CMD)
5705        nok=jjBRACK_Ma(p,u,&t1,&t2);
5706      else if (u->Typ() == BIGINTMAT_CMD)
5707        nok=jjBRACK_Bim(p,u,&t1,&t2);
5708      else /* INTMAT_CMD */
5709        nok=jjBRACK_Im(p,u,&t1,&t2);
5710      if (nok)
5711      {
5712        res->CleanUp();
5713        return TRUE;
5714      }
5715    }
5716  }
5717  return FALSE;
5718}
5719static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5720{
5721  v->next=(leftv)omAllocBin(sleftv_bin);
5722  memcpy(v->next,w,sizeof(sleftv));
5723  memset(w,0,sizeof(sleftv));
5724  return jjPROC(res,u,v);
5725}
5726static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5727{
5728  intvec *iv;
5729  ideal m;
5730  lists l=(lists)omAllocBin(slists_bin);
5731  int k=(int)(long)w->Data();
5732  if (k>=0)
5733  {
5734    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5735    l->Init(2);
5736    l->m[0].rtyp=MODUL_CMD;
5737    l->m[1].rtyp=INTVEC_CMD;
5738    l->m[0].data=(void *)m;
5739    l->m[1].data=(void *)iv;
5740  }
5741  else
5742  {
5743    m=sm_CallSolv((ideal)u->Data(), currRing);
5744    l->Init(1);
5745    l->m[0].rtyp=IDEAL_CMD;
5746    l->m[0].data=(void *)m;
5747  }
5748  res->data = (char *)l;
5749  return FALSE;
5750}
5751static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5752{
5753  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5754  {
5755    WerrorS("3rd argument must be a name of a matrix");
5756    return TRUE;
5757  }
5758  ideal i=(ideal)u->Data();
5759  int rank=(int)i->rank;
5760  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5761  if (r) return TRUE;
5762  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5763  return FALSE;
5764}
5765static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5766{
5767  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5768           (ideal)(v->Data()),(poly)(w->Data()));
5769  return FALSE;
5770}
5771static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5772{
5773  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5774  {
5775    WerrorS("3rd argument must be a name of a matrix");
5776    return TRUE;
5777  }
5778  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5779  poly p=(poly)u->CopyD(POLY_CMD);
5780  ideal i=idInit(1,1);
5781  i->m[0]=p;
5782  sleftv t;
5783  memset(&t,0,sizeof(t));
5784  t.data=(char *)i;
5785  t.rtyp=IDEAL_CMD;
5786  int rank=1;
5787  if (u->Typ()==VECTOR_CMD)
5788  {
5789    i->rank=rank=pMaxComp(p);
5790    t.rtyp=MODUL_CMD;
5791  }
5792  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5793  t.CleanUp();
5794  if (r) return TRUE;
5795  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5796  return FALSE;
5797}
5798static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5799{
5800  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5801    (intvec *)w->Data());
5802  //setFlag(res,FLAG_STD);
5803  return FALSE;
5804}
5805static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5806{
5807  /*4
5808  * look for the substring what in the string where
5809  * starting at position n
5810  * return the position of the first char of what in where
5811  * or 0
5812  */
5813  int n=(int)(long)w->Data();
5814  char *where=(char *)u->Data();
5815  char *what=(char *)v->Data();
5816  char *found;
5817  if ((1>n)||(n>(int)strlen(where)))
5818  {
5819    Werror("start position %d out of range",n);
5820    return TRUE;
5821  }
5822  found = strchr(where+n-1,*what);
5823  if (*(what+1)!='\0')
5824  {
5825    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5826    {
5827      found=strchr(found+1,*what);
5828    }
5829  }
5830  if (found != NULL)
5831  {
5832    res->data=(char *)((found-where)+1);
5833  }
5834  return FALSE;
5835}
5836static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5837{
5838  if ((int)(long)w->Data()==0)
5839    res->data=(char *)walkProc(u,v);
5840  else
5841    res->data=(char *)fractalWalkProc(u,v);
5842  setFlag( res, FLAG_STD );
5843  return FALSE;
5844}
5845static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5846{
5847  intvec *wdegree=(intvec*)w->Data();
5848  if (wdegree->length()!=currRing->N)
5849  {
5850    Werror("weight vector must have size %d, not %d",
5851           currRing->N,wdegree->length());
5852    return TRUE;
5853  }
5854#ifdef HAVE_RINGS
5855  if (rField_is_Ring_Z(currRing))
5856  {
5857    ring origR = currRing;
5858    ring tempR = rCopy(origR);
5859    coeffs new_cf=nInitChar(n_Q,NULL);
5860    nKillChar(tempR->cf);
5861    tempR->cf=new_cf;
5862    rComplete(tempR);
5863    ideal uid = (ideal)u->Data();
5864    rChangeCurrRing(tempR);
5865    ideal uu = idrCopyR(uid, origR, currRing);
5866    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5867    uuAsLeftv.rtyp = IDEAL_CMD;
5868    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5869    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5870    assumeStdFlag(&uuAsLeftv);
5871    Print("// NOTE: computation of Hilbert series etc. is being\n");
5872    Print("//       performed for generic fibre, that is, over Q\n");
5873    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5874    intvec *iv=hFirstSeries(uu,module_w,currRing->qideal,wdegree);
5875    int returnWithTrue = 1;
5876    switch((int)(long)v->Data())
5877    {
5878      case 1:
5879        res->data=(void *)iv;
5880        returnWithTrue = 0;
5881      case 2:
5882        res->data=(void *)hSecondSeries(iv);
5883        delete iv;
5884        returnWithTrue = 0;
5885    }
5886    if (returnWithTrue)
5887    {
5888      WerrorS(feNotImplemented);
5889      delete iv;
5890    }
5891    idDelete(&uu);
5892    rChangeCurrRing(origR);
5893    rDelete(tempR);
5894    if (returnWithTrue) return TRUE; else return FALSE;
5895  }
5896#endif
5897  assumeStdFlag(u);
5898  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5899  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
5900  switch((int)(long)v->Data())
5901  {
5902    case 1:
5903      res->data=(void *)iv;
5904      return FALSE;
5905    case 2:
5906      res->data=(void *)hSecondSeries(iv);
5907      delete iv;
5908      return FALSE;
5909  }
5910  WerrorS(feNotImplemented);
5911  delete iv;
5912  return TRUE;
5913}
5914static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
5915{
5916  PrintS("TODO\n");
5917  int i=pVar((poly)v->Data());
5918  if (i==0)
5919  {
5920    WerrorS("ringvar expected");
5921    return TRUE;
5922  }
5923  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5924  int d=pWTotaldegree(p);
5925  pLmDelete(p);
5926  if (d==1)
5927    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5928  else
5929    WerrorS("variable must have weight 1");
5930  return (d!=1);
5931}
5932static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
5933{
5934  PrintS("TODO\n");
5935  int i=pVar((poly)v->Data());
5936  if (i==0)
5937  {
5938    WerrorS("ringvar expected");
5939    return TRUE;
5940  }
5941  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5942  int d=pWTotaldegree(p);
5943  pLmDelete(p);
5944  if (d==1)
5945    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5946  else
5947    WerrorS("variable must have weight 1");
5948  return (d!=1);
5949}
5950static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5951{
5952  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5953  intvec* arg = (intvec*) u->Data();
5954  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5955
5956  for (i=0; i<n; i++)
5957  {
5958    (*im)[i] = (*arg)[i];
5959  }
5960
5961  res->data = (char *)im;
5962  return FALSE;
5963}
5964static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5965{
5966  short *iw=iv2array((intvec *)w->Data(),currRing);
5967  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5968  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
5969  return FALSE;
5970}
5971static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5972{
5973  if (!pIsUnit((poly)v->Data()))
5974  {
5975    WerrorS("2nd argument must be a unit");
5976    return TRUE;
5977  }
5978  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5979  return FALSE;
5980}
5981static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5982{
5983  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5984                             (intvec *)w->Data(),currRing);
5985  return FALSE;
5986}
5987static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5988{
5989  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
5990  {
5991    WerrorS("2nd argument must be a diagonal matrix of units");
5992    return TRUE;
5993  }
5994  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5995                               (matrix)v->CopyD());
5996  return FALSE;
5997}
5998static BOOLEAN currRingIsOverIntegralDomain ()
5999{
6000  /* true for fields and Z, false otherwise */
6001  if (rField_is_Ring_PtoM(currRing)) return FALSE;
6002  if (rField_is_Ring_2toM(currRing)) return FALSE;
6003  if (rField_is_Ring_ModN(currRing)) return FALSE;
6004  return TRUE;
6005}
6006static BOOLEAN jjMINOR_M(leftv res, leftv v)
6007{
6008  /* Here's the use pattern for the minor command:
6009        minor ( matrix_expression m, int_expression minorSize,
6010                optional ideal_expression IasSB, optional int_expression k,
6011                optional string_expression algorithm,
6012                optional int_expression cachedMinors,
6013                optional int_expression cachedMonomials )
6014     This method here assumes that there are at least two arguments.
6015     - If IasSB is present, it must be a std basis. All minors will be
6016       reduced w.r.t. IasSB.
6017     - If k is absent, all non-zero minors will be computed.
6018       If k is present and k > 0, the first k non-zero minors will be
6019       computed.
6020       If k is present and k < 0, the first |k| minors (some of which
6021       may be zero) will be computed.
6022       If k is present and k = 0, an error is reported.
6023     - If algorithm is absent, all the following arguments must be absent too.
6024       In this case, a heuristic picks the best-suited algorithm (among
6025       Bareiss, Laplace, and Laplace with caching).
6026       If algorithm is present, it must be one of "Bareiss", "bareiss",
6027       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6028       "cache" two more arguments may be given, determining how many entries
6029       the cache may have at most, and how many cached monomials there are at
6030       most. (Cached monomials are counted over all cached polynomials.)
6031       If these two additional arguments are not provided, 200 and 100000
6032       will be used as defaults.
6033  */
6034  matrix m;
6035  leftv u=v->next;
6036  v->next=NULL;
6037  int v_typ=v->Typ();
6038  if (v_typ==MATRIX_CMD)
6039  {
6040     m = (const matrix)v->Data();
6041  }
6042  else
6043  {
6044    if (v_typ==0)
6045    {
6046      Werror("`%s` is undefined",v->Fullname());
6047      return TRUE;
6048    }
6049    // try to convert to MATRIX:
6050    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6051    BOOLEAN bo;
6052    sleftv tmp;
6053    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6054    else bo=TRUE;
6055    if (bo)
6056    {
6057      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6058      return TRUE;
6059    }
6060    m=(matrix)tmp.data;
6061  }
6062  const int mk = (const int)(long)u->Data();
6063  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6064  bool noCacheMinors = true; bool noCacheMonomials = true;
6065  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6066
6067  /* here come the different cases of correct argument sets */
6068  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6069  {
6070    IasSB = (ideal)u->next->Data();
6071    noIdeal = false;
6072    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6073    {
6074      k = (int)(long)u->next->next->Data();
6075      noK = false;
6076      assume(k != 0);
6077      if ((u->next->next->next != NULL) &&
6078          (u->next->next->next->Typ() == STRING_CMD))
6079      {
6080        algorithm = (char*)u->next->next->next->Data();
6081        noAlgorithm = false;
6082        if ((u->next->next->next->next != NULL) &&
6083            (u->next->next->next->next->Typ() == INT_CMD))
6084        {
6085          cacheMinors = (int)(long)u->next->next->next->next->Data();
6086          noCacheMinors = false;
6087          if ((u->next->next->next->next->next != NULL) &&
6088              (u->next->next->next->next->next->Typ() == INT_CMD))
6089          {
6090            cacheMonomials =
6091               (int)(long)u->next->next->next->next->next->Data();
6092            noCacheMonomials = false;
6093          }
6094        }
6095      }
6096    }
6097  }
6098  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6099  {
6100    k = (int)(long)u->next->Data();
6101    noK = false;
6102    assume(k != 0);
6103    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6104    {
6105      algorithm = (char*)u->next->next->Data();
6106      noAlgorithm = false;
6107      if ((u->next->next->next != NULL) &&
6108          (u->next->next->next->Typ() == INT_CMD))
6109      {
6110        cacheMinors = (int)(long)u->next->next->next->Data();
6111        noCacheMinors = false;
6112        if ((u->next->next->next->next != NULL) &&
6113            (u->next->next->next->next->Typ() == INT_CMD))
6114        {
6115          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6116          noCacheMonomials = false;
6117        }
6118      }
6119    }
6120  }
6121  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6122  {
6123    algorithm = (char*)u->next->Data();
6124    noAlgorithm = false;
6125    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6126    {
6127      cacheMinors = (int)(long)u->next->next->Data();
6128      noCacheMinors = false;
6129      if ((u->next->next->next != NULL) &&
6130          (u->next->next->next->Typ() == INT_CMD))
6131      {
6132        cacheMonomials = (int)(long)u->next->next->next->Data();
6133        noCacheMonomials = false;
6134      }
6135    }
6136  }
6137
6138  /* upper case conversion for the algorithm if present */
6139  if (!noAlgorithm)
6140  {
6141    if (strcmp(algorithm, "bareiss") == 0)
6142      algorithm = (char*)"Bareiss";
6143    if (strcmp(algorithm, "laplace") == 0)
6144      algorithm = (char*)"Laplace";
6145    if (strcmp(algorithm, "cache") == 0)
6146      algorithm = (char*)"Cache";
6147  }
6148
6149  v->next=u;
6150  /* here come some tests */
6151  if (!noIdeal)
6152  {
6153    assumeStdFlag(u->next);
6154  }
6155  if ((!noK) && (k == 0))
6156  {
6157    WerrorS("Provided number of minors to be computed is zero.");
6158    return TRUE;
6159  }
6160  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6161      && (strcmp(algorithm, "Laplace") != 0)
6162      && (strcmp(algorithm, "Cache") != 0))
6163  {
6164    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6165    return TRUE;
6166  }
6167  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6168      && (!currRingIsOverIntegralDomain()))
6169  {
6170    Werror("Bareiss algorithm not defined over coefficient rings %s",
6171           "with zero divisors.");
6172    return TRUE;
6173  }
6174  res->rtyp=IDEAL_CMD;
6175  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6176  {
6177    ideal I=idInit(1,1);
6178    if (mk<1) I->m[0]=p_One(currRing);
6179    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6180    //       m->rows(), m->cols());
6181    res->data=(void*)I;
6182    return FALSE;
6183  }
6184  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6185      && (noCacheMinors || noCacheMonomials))
6186  {
6187    cacheMinors = 200;
6188    cacheMonomials = 100000;
6189  }
6190
6191  /* here come the actual procedure calls */
6192  if (noAlgorithm)
6193    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6194                                       (noIdeal ? 0 : IasSB), false);
6195  else if (strcmp(algorithm, "Cache") == 0)
6196    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6197                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6198                                   cacheMonomials, false);
6199  else
6200    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6201                              (noIdeal ? 0 : IasSB), false);
6202  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6203  return FALSE;
6204}
6205static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6206{
6207  // u: the name of the new type
6208  // v: the parent type
6209  // w: the elements
6210  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6211                                            (const char *)w->Data());
6212  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6213  return (d==NULL);
6214}
6215static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6216{
6217  // handles preimage(r,phi,i) and kernel(r,phi)
6218  idhdl h;
6219  ring rr;
6220  map mapping;
6221  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6222
6223  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6224  {
6225    WerrorS("2nd/3rd arguments must have names");
6226    return TRUE;
6227  }
6228  rr=(ring)u->Data();
6229  const char *ring_name=u->Name();
6230  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6231  {
6232    if (h->typ==MAP_CMD)
6233    {
6234      mapping=IDMAP(h);
6235      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6236      if ((preim_ring==NULL)
6237      || (IDRING(preim_ring)!=currRing))
6238      {
6239        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6240        return TRUE;
6241      }
6242    }
6243    else if (h->typ==IDEAL_CMD)
6244    {
6245      mapping=IDMAP(h);
6246    }
6247    else
6248    {
6249      Werror("`%s` is no map nor ideal",IDID(h));
6250      return TRUE;
6251    }
6252  }
6253  else
6254  {
6255    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6256    return TRUE;
6257  }
6258  ideal image;
6259  if (kernel_cmd) image=idInit(1,1);
6260  else
6261  {
6262    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6263    {
6264      if (h->typ==IDEAL_CMD)
6265      {
6266        image=IDIDEAL(h);
6267      }
6268      else
6269      {
6270        Werror("`%s` is no ideal",IDID(h));
6271        return TRUE;
6272      }
6273    }
6274    else
6275    {
6276      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6277      return TRUE;
6278    }
6279  }
6280  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6281  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6282  {
6283    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6284  }
6285  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6286  if (kernel_cmd) idDelete(&image);
6287  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6288}
6289static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6290{
6291  int di, k;
6292  int i=(int)(long)u->Data();
6293  int r=(int)(long)v->Data();
6294  int c=(int)(long)w->Data();
6295  if ((r<=0) || (c<=0)) return TRUE;
6296  intvec *iv = new intvec(r, c, 0);
6297  if (iv->rows()==0)
6298  {
6299    delete iv;
6300    return TRUE;
6301  }
6302  if (i!=0)
6303  {
6304    if (i<0) i = -i;
6305    di = 2 * i + 1;
6306    for (k=0; k<iv->length(); k++)
6307    {
6308      (*iv)[k] = ((siRand() % di) - i);
6309    }
6310  }
6311  res->data = (char *)iv;
6312  return FALSE;
6313}
6314#ifdef SINGULAR_4_1
6315static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6316// <coeff>, par1, par2 -> number2
6317{
6318  coeffs cf=(coeffs)u->Data();
6319  if ((cf!=NULL) && (cf->cfRandom!=NULL))
6320  {
6321    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6322    number2 nn=(number2)omAlloc(sizeof(*nn));
6323    nn->cf=cf;
6324    nn->n=n;
6325    res->data=nn;
6326    return FALSE;
6327  }
6328  return TRUE;
6329}
6330#endif
6331static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6332  int &ringvar, poly &monomexpr)
6333{
6334  monomexpr=(poly)w->Data();
6335  poly p=(poly)v->Data();
6336#if 0
6337  if (pLength(monomexpr)>1)
6338  {
6339    Werror("`%s` substitutes a ringvar only by a term",
6340      Tok2Cmdname(SUBST_CMD));
6341    return TRUE;
6342  }
6343#endif
6344  if ((ringvar=pVar(p))==0)
6345  {
6346    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6347    {
6348      number n = pGetCoeff(p);
6349      ringvar= -n_IsParam(n, currRing);
6350    }
6351    if(ringvar==0)
6352    {
6353      WerrorS("ringvar/par expected");
6354      return TRUE;
6355    }
6356  }
6357  return FALSE;
6358}
6359static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6360{
6361  int ringvar;
6362  poly monomexpr;
6363  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6364  if (nok) return TRUE;
6365  poly p=(poly)u->Data();
6366  if (ringvar>0)
6367  {
6368    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6369    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p)/2)))
6370    {
6371      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), pTotaldegree(p));
6372      //return TRUE;
6373    }
6374    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6375      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6376    else
6377      res->data= pSubstPoly(p,ringvar,monomexpr);
6378  }
6379  else
6380  {
6381    res->data=pSubstPar(p,-ringvar,monomexpr);
6382  }
6383  return FALSE;
6384}
6385static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6386{
6387  int ringvar;
6388  poly monomexpr;
6389  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6390  if (nok) return TRUE;
6391  ideal id=(ideal)u->Data();
6392  if (ringvar>0)
6393  {
6394    BOOLEAN overflow=FALSE;
6395    if (monomexpr!=NULL)
6396    {
6397      long deg_monexp=pTotaldegree(monomexpr);
6398      for(int i=IDELEMS(id)-1;i>=0;i--)
6399      {
6400        poly p=id->m[i];
6401        if ((p!=NULL) && (pTotaldegree(p)!=0) &&
6402        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)pTotaldegree(p)/2)))
6403        {
6404          overflow=TRUE;
6405          break;
6406        }
6407      }
6408    }
6409    if (overflow)
6410      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6411    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6412    {
6413      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6414      else                       id=id_Copy(id,currRing);
6415      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6416    }
6417    else
6418      res->data = idSubstPoly(id,ringvar,monomexpr);
6419  }
6420  else
6421  {
6422    res->data = idSubstPar(id,-ringvar,monomexpr);
6423  }
6424  return FALSE;
6425}
6426// we do not want to have jjSUBST_Id_X inlined:
6427static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6428                            int input_type);
6429static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6430{
6431  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6432}
6433static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6434{
6435  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6436}
6437static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6438{
6439  sleftv tmp;
6440  memset(&tmp,0,sizeof(tmp));
6441  // do not check the result, conversion from int/number to poly works always
6442  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6443  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6444  tmp.CleanUp();
6445  return b;
6446}
6447static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6448{
6449  int mi=(int)(long)v->Data();
6450  int ni=(int)(long)w->Data();
6451  if ((mi<1)||(ni<1))
6452  {
6453    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6454    return TRUE;
6455  }
6456  matrix m=mpNew(mi,ni);
6457  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6458  int i=si_min(IDELEMS(I),mi*ni);
6459  //for(i=i-1;i>=0;i--)
6460  //{
6461  //  m->m[i]=I->m[i];
6462  //  I->m[i]=NULL;
6463  //}
6464  memcpy(m->m,I->m,i*sizeof(poly));
6465  memset(I->m,0,i*sizeof(poly));
6466  id_Delete(&I,currRing);
6467  res->data = (char *)m;
6468  return FALSE;
6469}
6470static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6471{
6472  int mi=(int)(long)v->Data();
6473  int ni=(int)(long)w->Data();
6474  if ((mi<1)||(ni<1))
6475  {
6476    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6477    return TRUE;
6478  }
6479  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6480           mi,ni,currRing);
6481  return FALSE;
6482}
6483static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6484{
6485  int mi=(int)(long)v->Data();
6486  int ni=(int)(long)w->Data();
6487  if ((mi<1)||(ni<1))
6488  {
6489     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6490    return TRUE;
6491  }
6492  matrix m=mpNew(mi,ni);
6493  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6494  int r=si_min(MATROWS(I),mi);
6495  int c=si_min(MATCOLS(I),ni);
6496  int i,j;
6497  for(i=r;i>0;i--)
6498  {
6499    for(j=c;j>0;j--)
6500    {
6501      MATELEM(m,i,j)=MATELEM(I,i,j);
6502      MATELEM(I,i,j)=NULL;
6503    }
6504  }
6505  id_Delete((ideal *)&I,currRing);
6506  res->data = (char *)m;
6507  return FALSE;
6508}
6509static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6510{
6511  if (w->rtyp!=IDHDL) return TRUE;
6512  int ul= IDELEMS((ideal)u->Data());
6513  int vl= IDELEMS((ideal)v->Data());
6514  ideal m
6515    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6516             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6517  if (m==NULL) return TRUE;
6518  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6519  return FALSE;
6520}
6521static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6522{
6523  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6524  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6525  idhdl hv=(idhdl)v->data;
6526  idhdl hw=(idhdl)w->data;
6527  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6528  res->data = (char *)idLiftStd((ideal)u->Data(),
6529                                &(hv->data.umatrix),testHomog,
6530                                &(hw->data.uideal));
6531  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6532  return FALSE;
6533}
6534static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6535{
6536  assumeStdFlag(v);
6537  if (!idIsZeroDim((ideal)v->Data()))
6538  {
6539    Werror("`%s` must be 0-dimensional",v->Name());
6540    return TRUE;
6541  }
6542  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6543    (poly)w->CopyD());
6544  return FALSE;
6545}
6546static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6547{
6548  assumeStdFlag(v);
6549  if (!idIsZeroDim((ideal)v->Data()))
6550  {
6551    Werror("`%s` must be 0-dimensional",v->Name());
6552    return TRUE;
6553  }
6554  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6555    (matrix)w->CopyD());
6556  return FALSE;
6557}
6558static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6559{
6560  assumeStdFlag(v);
6561  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6562    0,(int)(long)w->Data());
6563  return FALSE;
6564}
6565static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6566{
6567  assumeStdFlag(v);
6568  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6569    0,(int)(long)w->Data());
6570  return FALSE;
6571}
6572#ifdef OLD_RES
6573static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6574{
6575  int maxl=(int)v->Data();
6576  ideal u_id=(ideal)u->Data();
6577  int l=0;
6578  resolvente r;
6579  intvec **weights=NULL;
6580  int wmaxl=maxl;
6581  maxl--;
6582  if ((maxl==-1) && (iiOp!=MRES_CMD))
6583    maxl = currRing->N-1;
6584  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6585  {
6586    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6587    if (iv!=NULL)
6588    {
6589      l=1;
6590      if (!idTestHomModule(u_id,currRing->qideal,iv))
6591      {
6592        WarnS("wrong weights");
6593        iv=NULL;
6594      }
6595      else
6596      {
6597        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6598        weights[0] = ivCopy(iv);
6599      }
6600    }
6601    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6602  }
6603  else
6604    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6605  if (r==NULL) return TRUE;
6606  int t3=u->Typ();
6607  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6608  return FALSE;
6609}
6610#endif
6611static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6612{
6613  res->data=(void *)rInit(u,v,w);
6614  return (res->data==NULL);
6615}
6616static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6617{
6618  int yes;
6619  jjSTATUS2(res, u, v);
6620  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6621  omFree((ADDRESS) res->data);
6622  res->data = (void *)(long)yes;
6623  return FALSE;
6624}
6625static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6626{
6627  intvec *vw=(intvec *)w->Data(); // weights of vars
6628  if (vw->length()!=currRing->N)
6629  {
6630    Werror("%d weights for %d variables",vw->length(),currRing->N);
6631    return TRUE;
6632  }
6633  ideal result;
6634  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6635  tHomog hom=testHomog;
6636  ideal u_id=(ideal)(u->Data());
6637  if (ww!=NULL)
6638  {
6639    if (!idTestHomModule(u_id,currRing->qideal,ww))
6640    {
6641      WarnS("wrong weights");
6642      ww=NULL;
6643    }
6644    else
6645    {
6646      ww=ivCopy(ww);
6647      hom=isHomog;
6648    }
6649  }
6650  result=kStd(u_id,
6651              currRing->qideal,
6652              hom,
6653              &ww,                  // module weights
6654              (intvec *)v->Data(),  // hilbert series
6655              0,0,                  // syzComp, newIdeal
6656              vw);                  // weights of vars
6657  idSkipZeroes(result);
6658  res->data = (char *)result;
6659  setFlag(res,FLAG_STD);
6660  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6661  return FALSE;
6662}
6663
6664/*=================== operations with many arg.: static proc =================*/
6665/* must be ordered: first operations for chars (infix ops),
6666 * then alphabetically */
6667static BOOLEAN jjBREAK0(leftv, leftv)
6668{
6669#ifdef HAVE_SDB
6670  sdb_show_bp();
6671#endif
6672  return FALSE;
6673}
6674static BOOLEAN jjBREAK1(leftv, leftv v)
6675{
6676#ifdef HAVE_SDB
6677  if(v->Typ()==PROC_CMD)
6678  {
6679    int lineno=0;
6680    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6681    {
6682      lineno=(int)(long)v->next->Data();
6683    }
6684    return sdb_set_breakpoint(v->Name(),lineno);
6685  }
6686  return TRUE;
6687#else
6688 return FALSE;
6689#endif
6690}
6691static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6692{
6693  return iiExprArith1(res,v,iiOp);
6694}
6695static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6696{
6697  leftv v=u->next;
6698  u->next=NULL;
6699  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6700  u->next=v;
6701  return b;
6702}
6703static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6704{
6705  leftv v = u->next;
6706  leftv w = v->next;
6707  u->next = NULL;
6708  v->next = NULL;
6709  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6710  u->next = v;
6711  v->next = w;
6712  return b;
6713}
6714
6715static BOOLEAN jjCOEF_M(leftv, leftv v)
6716{
6717  short t[]={5,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD,IDHDL};
6718  if (iiCheckTypes(v,t))
6719     return TRUE;
6720  idhdl c=(idhdl)v->next->next->data;
6721  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6722  idhdl m=(idhdl)v->next->next->next->data;
6723  idDelete((ideal *)&(c->data.uideal));
6724  idDelete((ideal *)&(m->data.uideal));
6725  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6726    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6727  return FALSE;
6728}
6729
6730static BOOLEAN jjDIVISION4(leftv res, leftv v)
6731{ // may have 3 or 4 arguments
6732  leftv v1=v;
6733  leftv v2=v1->next;
6734  leftv v3=v2->next;
6735  leftv v4=v3->next;
6736  assumeStdFlag(v2);
6737
6738  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6739  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6740
6741  if((i1==0)||(i2==0)
6742  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6743  {
6744    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6745    return TRUE;
6746  }
6747
6748  sleftv w1,w2;
6749  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6750  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6751  ideal P=(ideal)w1.Data();
6752  ideal Q=(ideal)w2.Data();
6753
6754  int n=(int)(long)v3->Data();
6755  short *w=NULL;
6756  if(v4!=NULL)
6757  {
6758    w = iv2array((intvec *)v4->Data(),currRing);
6759    short * w0 = w + 1;
6760    int i = currRing->N;
6761    while( (i > 0) && ((*w0) > 0) )
6762    {
6763      w0++;
6764      i--;
6765    }
6766    if(i>0)
6767      WarnS("not all weights are positive!");
6768  }
6769
6770  matrix T;
6771  ideal R;
6772  idLiftW(P,Q,n,T,R,w);
6773
6774  w1.CleanUp();
6775  w2.CleanUp();
6776  if(w!=NULL)
6777    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
6778
6779  lists L=(lists) omAllocBin(slists_bin);
6780  L->Init(2);
6781  L->m[1].rtyp=v1->Typ();
6782  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6783  {
6784    if(v1->Typ()==POLY_CMD)
6785      p_Shift(&R->m[0],-1,currRing);
6786    L->m[1].data=(void *)R->m[0];
6787    R->m[0]=NULL;
6788    idDelete(&R);
6789  }
6790  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6791    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6792  else
6793  {
6794    L->m[1].rtyp=MODUL_CMD;
6795    L->m[1].data=(void *)R;
6796  }
6797  L->m[0].rtyp=MATRIX_CMD;
6798  L->m[0].data=(char *)T;
6799
6800  res->data=L;
6801  res->rtyp=LIST_CMD;
6802
6803  return FALSE;
6804}
6805
6806//BOOLEAN jjDISPATCH(leftv res, leftv v)
6807//{
6808//  WerrorS("`dispatch`: not implemented");
6809//  return TRUE;
6810//}
6811
6812//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6813//{
6814//  int l=u->listLength();
6815//  if (l<2) return TRUE;
6816//  BOOLEAN b;
6817//  leftv v=u->next;
6818//  leftv zz=v;
6819//  leftv z=zz;
6820//  u->next=NULL;
6821//  do
6822//  {
6823//    leftv z=z->next;
6824//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6825//    if (b) break;
6826//  } while (z!=NULL);
6827//  u->next=zz;
6828//  return b;
6829//}
6830static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6831{
6832  int s=1;
6833  leftv h=v;
6834  if (h!=NULL) s=exprlist_length(h);
6835  ideal id=idInit(s,1);
6836  int rank=1;
6837  int i=0;
6838  poly p;
6839  while (h!=NULL)
6840  {
6841    switch(h->Typ())
6842    {
6843      case POLY_CMD:
6844      {
6845        p=(poly)h->CopyD(POLY_CMD);
6846        break;
6847      }
6848      case INT_CMD:
6849      {
6850        number n=nInit((int)(long)h->Data());
6851        if (!nIsZero(n))
6852        {
6853          p=pNSet(n);
6854        }
6855        else
6856        {
6857          p=NULL;
6858          nDelete(&n);
6859        }
6860        break;
6861      }
6862      case BIGINT_CMD:
6863      {
6864        number b=(number)h->Data();
6865        nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
6866        if (nMap==NULL) return TRUE;
6867        number n=nMap(b,coeffs_BIGINT,currRing->cf);
6868        if (!nIsZero(n))
6869        {
6870          p=pNSet(n);
6871        }
6872        else
6873        {
6874          p=NULL;
6875          nDelete(&n);
6876        }
6877        break;
6878      }
6879      case NUMBER_CMD:
6880      {
6881        number n=(number)h->CopyD(NUMBER_CMD);
6882        if (!nIsZero(n))
6883        {
6884          p=pNSet(n);
6885        }
6886        else
6887        {
6888          p=NULL;
6889          nDelete(&n);
6890        }
6891        break;
6892      }
6893      case VECTOR_CMD:
6894      {
6895        p=(poly)h->CopyD(VECTOR_CMD);
6896        if (iiOp!=MODUL_CMD)
6897        {
6898          idDelete(&id);
6899          pDelete(&p);
6900          return TRUE;
6901        }
6902        rank=si_max(rank,(int)pMaxComp(p));
6903        break;
6904      }
6905      default:
6906      {
6907        idDelete(&id);
6908        return TRUE;
6909      }
6910    }
6911    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6912    {
6913      pSetCompP(p,1);
6914    }
6915    id->m[i]=p;
6916    i++;
6917    h=h->next;
6918  }
6919  id->rank=rank;
6920  res->data=(char *)id;
6921  return FALSE;
6922}
6923static BOOLEAN jjFETCH_M(leftv res, leftv u)
6924{
6925  ring r=(ring)u->Data();
6926  leftv v=u->next;
6927  leftv perm_var_l=v->next;
6928  leftv perm_par_l=v->next->next;
6929  if ((perm_var_l->Typ()!=INTVEC_CMD)
6930  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
6931  ||((u->Typ()!=RING_CMD)&&(u->Typ()!=QRING_CMD)))
6932  {
6933    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
6934    return TRUE;
6935  }
6936  intvec *perm_var_v=(intvec*)perm_var_l->Data();
6937  intvec *perm_par_v=NULL;
6938  if (perm_par_l!=NULL)
6939    perm_par_v=(intvec*)perm_par_l->Data();
6940  idhdl w;
6941  nMapFunc nMap;
6942
6943  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
6944  {
6945    int *perm=NULL;
6946    int *par_perm=NULL;
6947    int par_perm_size=0;
6948    BOOLEAN bo;
6949    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
6950    {
6951      // Allow imap/fetch to be make an exception only for:
6952      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
6953            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
6954             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
6955           ||
6956           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
6957            (rField_is_Zp(currRing, r->cf->ch) ||
6958             rField_is_Zp_a(currRing, r->cf->ch))) )
6959      {
6960        par_perm_size=rPar(r);
6961      }
6962      else
6963      {
6964        goto err_fetch;
6965      }
6966    }
6967    else
6968      par_perm_size=rPar(r);
6969    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
6970    if (par_perm_size!=0)
6971      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
6972    int i;
6973    if (perm_par_l==NULL)
6974    {
6975      if (par_perm_size!=0)
6976        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
6977    }
6978    else
6979    {
6980      if (par_perm_size==0) WarnS("source ring has no parameters");
6981      else
6982      {
6983        for(i=rPar(r)-1;i>=0;i--)
6984        {
6985          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
6986          if ((par_perm[i]<-rPar(currRing))
6987          || (par_perm[i]>rVar(currRing)))
6988          {
6989            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
6990            par_perm[i]=0;
6991          }
6992        }
6993      }
6994    }
6995    for(i=rVar(r)-1;i>=0;i--)
6996    {
6997      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
6998      if ((perm[i]<-rPar(currRing))
6999      || (perm[i]>rVar(currRing)))
7000      {
7001        Warn("invalid entry for var %d: %d\n",i,perm[i]);
7002        perm[i]=0;
7003      }
7004    }
7005    if (BVERBOSE(V_IMAP))
7006    {
7007      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
7008      {
7009        if (perm[i]>0)
7010          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
7011        else if (perm[i]<0)
7012          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
7013      }
7014      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
7015      {
7016        if (par_perm[i-1]<0)
7017          Print("// par nr %d: %s -> par %s\n",
7018              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
7019        else if (par_perm[i-1]>0)
7020          Print("// par nr %d: %s -> var %s\n",
7021              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7022      }
7023    }
7024    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7025    sleftv tmpW;
7026    memset(&tmpW,0,sizeof(sleftv));
7027    tmpW.rtyp=IDTYP(w);
7028    tmpW.data=IDDATA(w);
7029    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7030                         perm,par_perm,par_perm_size,nMap)))
7031    {
7032      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7033    }
7034    if (perm!=NULL)
7035      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7036    if (par_perm!=NULL)
7037      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7038    return bo;
7039  }
7040  else
7041  {
7042    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7043  }
7044  return TRUE;
7045err_fetch:
7046  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
7047         nCoeffString(r->cf),
7048         nCoeffString(currRing->cf));
7049  return TRUE;
7050}
7051static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7052{
7053  leftv h=v;
7054  int l=v->listLength();
7055  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7056  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7057  int t=0;
7058  // try to convert to IDEAL_CMD
7059  while (h!=NULL)
7060  {
7061    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7062    {
7063      t=IDEAL_CMD;
7064    }
7065    else break;
7066    h=h->next;
7067  }
7068  // if failure, try MODUL_CMD
7069  if (t==0)
7070  {
7071    h=v;
7072    while (h!=NULL)
7073    {
7074      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7075      {
7076        t=MODUL_CMD;
7077      }
7078      else break;
7079      h=h->next;
7080    }
7081  }
7082  // check for success  in converting
7083  if (t==0)
7084  {
7085    WerrorS("cannot convert to ideal or module");
7086    return TRUE;
7087  }
7088  // call idMultSect
7089  h=v;
7090  int i=0;
7091  sleftv tmp;
7092  while (h!=NULL)
7093  {
7094    if (h->Typ()==t)
7095    {
7096      r[i]=(ideal)h->Data(); /*no copy*/
7097      h=h->next;
7098    }
7099    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7100    {
7101      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7102      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7103      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7104      return TRUE;
7105    }
7106    else
7107    {
7108      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7109      copied[i]=TRUE;
7110      h=tmp.next;
7111    }
7112    i++;
7113  }
7114  res->rtyp=t;
7115  res->data=(char *)idMultSect(r,i);
7116  while(i>0)
7117  {
7118    i--;
7119    if (copied[i]) idDelete(&(r[i]));
7120  }
7121  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7122  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7123  return FALSE;
7124}
7125static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7126{
7127  /* computation of the inverse of a quadratic matrix A
7128     using the L-U-decomposition of A;
7129     There are two valid parametrisations:
7130     1) exactly one argument which is just the matrix A,
7131     2) exactly three arguments P, L, U which already
7132        realise the L-U-decomposition of A, that is,
7133        P * A = L * U, and P, L, and U satisfy the
7134        properties decribed in method 'jjLU_DECOMP';
7135        see there;
7136     If A is invertible, the list [1, A^(-1)] is returned,
7137     otherwise the list [0] is returned. Thus, the user may
7138     inspect the first entry of the returned list to see
7139     whether A is invertible. */
7140  matrix iMat; int invertible;
7141  short t1[]={1,MATRIX_CMD};
7142  short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7143  if (iiCheckTypes(v,t1))
7144  {
7145    matrix aMat = (matrix)v->Data();
7146    int rr = aMat->rows();
7147    int cc = aMat->cols();
7148    if (rr != cc)
7149    {
7150      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7151      return TRUE;
7152    }
7153    if (!idIsConstant((ideal)aMat))
7154    {
7155      WerrorS("matrix must be constant");
7156      return TRUE;
7157    }
7158    invertible = luInverse(aMat, iMat);
7159  }
7160  else if (iiCheckTypes(v,t2))
7161  {
7162     matrix pMat = (matrix)v->Data();
7163     matrix lMat = (matrix)v->next->Data();
7164     matrix uMat = (matrix)v->next->next->Data();
7165     int rr = uMat->rows();
7166     int cc = uMat->cols();
7167     if (rr != cc)
7168     {
7169       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7170              rr, cc);
7171       return TRUE;
7172     }
7173      if (!idIsConstant((ideal)pMat)
7174      || (!idIsConstant((ideal)lMat))
7175      || (!idIsConstant((ideal)uMat))
7176      )
7177      {
7178        WerrorS("matricesx must be constant");
7179        return TRUE;
7180      }
7181     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7182  }
7183  else
7184  {
7185    Werror("expected either one or three matrices");
7186    return TRUE;
7187  }
7188
7189  /* build the return structure; a list with either one or two entries */
7190  lists ll = (lists)omAllocBin(slists_bin);
7191  if (invertible)
7192  {
7193    ll->Init(2);
7194    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7195    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7196  }
7197  else
7198  {
7199    ll->Init(1);
7200    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7201  }
7202
7203  res->data=(char*)ll;
7204  return FALSE;
7205}
7206static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7207{
7208  /* for solving a linear equation system A * x = b, via the
7209     given LU-decomposition of the matrix A;
7210     There is one valid parametrisation:
7211     1) exactly four arguments P, L, U, b;
7212        P, L, and U realise the L-U-decomposition of A, that is,
7213        P * A = L * U, and P, L, and U satisfy the
7214        properties decribed in method 'jjLU_DECOMP';
7215        see there;
7216        b is the right-hand side vector of the equation system;
7217     The method will return a list of either 1 entry or three entries:
7218     1) [0] if there is no solution to the system;
7219     2) [1, x, H] if there is at least one solution;
7220        x is any solution of the given linear system,
7221        H is the matrix with column vectors spanning the homogeneous
7222        solution space.
7223     The method produces an error if matrix and vector sizes do not fit. */
7224  short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7225  if (!iiCheckTypes(v,t))
7226  {
7227    WerrorS("expected exactly three matrices and one vector as input");
7228    return TRUE;
7229  }
7230  matrix pMat = (matrix)v->Data();
7231  matrix lMat = (matrix)v->next->Data();
7232  matrix uMat = (matrix)v->next->next->Data();
7233  matrix bVec = (matrix)v->next->next->next->Data();
7234  matrix xVec; int solvable; matrix homogSolSpace;
7235  if (pMat->rows() != pMat->cols())
7236  {
7237    Werror("first matrix (%d x %d) is not quadratic",
7238           pMat->rows(), pMat->cols());
7239    return TRUE;
7240  }
7241  if (lMat->rows() != lMat->cols())
7242  {
7243    Werror("second matrix (%d x %d) is not quadratic",
7244           lMat->rows(), lMat->cols());
7245    return TRUE;
7246  }
7247  if (lMat->rows() != uMat->rows())
7248  {
7249    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7250           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7251    return TRUE;
7252  }
7253  if (uMat->rows() != bVec->rows())
7254  {
7255    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7256           uMat->rows(), uMat->cols(), bVec->rows());
7257    return TRUE;
7258  }
7259  if (!idIsConstant((ideal)pMat)
7260  ||(!idIsConstant((ideal)lMat))
7261  ||(!idIsConstant((ideal)uMat))
7262  )
7263  {
7264    WerrorS("matrices must be constant");
7265    return TRUE;
7266  }
7267  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7268
7269  /* build the return structure; a list with either one or three entries */
7270  lists ll = (lists)omAllocBin(slists_bin);
7271  if (solvable)
7272  {
7273    ll->Init(3);
7274    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7275    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7276    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7277  }
7278  else
7279  {
7280    ll->Init(1);
7281    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7282  }
7283
7284  res->data=(char*)ll;
7285  return FALSE;
7286}
7287static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7288{
7289  int i=0;
7290  leftv h=v;
7291  if (h!=NULL) i=exprlist_length(h);
7292  intvec *iv=new intvec(i);
7293  i=0;
7294  while (h!=NULL)
7295  {
7296    if(h->Typ()==INT_CMD)
7297    {
7298      (*iv)[i]=(int)(long)h->Data();
7299    }
7300    else if (h->Typ()==INTVEC_CMD)
7301    {
7302      intvec *ivv=(intvec*)h->Data();
7303      for(int j=0;j<ivv->length();j++,i++)
7304      {
7305        (*iv)[i]=(*ivv)[j];
7306      }
7307      i--;
7308    }
7309    else
7310    {
7311      delete iv;
7312      return TRUE;
7313    }
7314    i++;
7315    h=h->next;
7316  }
7317  res->data=(char *)iv;
7318  return FALSE;
7319}
7320static BOOLEAN jjJET4(leftv res, leftv u)
7321{
7322  short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7323  short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7324  short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7325  short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7326  leftv u1=u;
7327  leftv u2=u1->next;
7328  leftv u3=u2->next;
7329  leftv u4=u3->next;
7330  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7331  {
7332    if(!pIsUnit((poly)u2->Data()))
7333    {
7334      WerrorS("2nd argument must be a unit");
7335      return TRUE;
7336    }
7337    res->rtyp=u1->Typ();
7338    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7339                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7340    return FALSE;
7341  }
7342  else
7343  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7344  {
7345    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7346    {
7347      WerrorS("2nd argument must be a diagonal matrix of units");
7348      return TRUE;
7349    }
7350    res->rtyp=u1->Typ();
7351    res->data=(char*)idSeries(
7352                              (int)(long)u3->Data(),
7353                              idCopy((ideal)u1->Data()),
7354                              mp_Copy((matrix)u2->Data(), currRing),
7355                              (intvec*)u4->Data()
7356                             );
7357    return FALSE;
7358  }
7359  else
7360  {
7361    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7362           Tok2Cmdname(iiOp));
7363    return TRUE;
7364  }
7365}
7366static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7367{
7368  if ((yyInRingConstruction)
7369  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7370  {
7371    memcpy(res,u,sizeof(sleftv));
7372    memset(u,0,sizeof(sleftv));
7373    return FALSE;
7374  }
7375  leftv v=u->next;
7376  BOOLEAN b;
7377  if(v==NULL)
7378    b=iiExprArith1(res,u,iiOp);
7379  else
7380  {
7381    u->next=NULL;
7382    b=iiExprArith2(res,u,iiOp,v);
7383    u->next=v;
7384  }
7385  return b;
7386}
7387BOOLEAN jjLIST_PL(leftv res, leftv v)
7388{
7389  int sl=0;
7390  if (v!=NULL) sl = v->listLength();
7391  lists L;
7392  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7393  {
7394    int add_row_shift = 0;
7395    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7396    if (weights!=NULL)  add_row_shift=weights->min_in();
7397    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7398  }
7399  else
7400  {
7401    L=(lists)omAllocBin(slists_bin);
7402    leftv h=NULL;
7403    int i;
7404    int rt;
7405
7406    L->Init(sl);
7407    for (i=0;i<sl;i++)
7408    {
7409      if (h!=NULL)
7410      { /* e.g. not in the first step:
7411         * h is the pointer to the old sleftv,
7412         * v is the pointer to the next sleftv
7413         * (in this moment) */
7414         h->next=v;
7415      }
7416      h=v;
7417      v=v->next;
7418      h->next=NULL;
7419      rt=h->Typ();
7420      if (rt==0)
7421      {
7422        L->Clean();
7423        Werror("`%s` is undefined",h->Fullname());
7424        return TRUE;
7425      }
7426      if ((rt==RING_CMD)||(rt==QRING_CMD))
7427      {
7428        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7429        ((ring)L->m[i].data)->ref++;
7430      }
7431      else
7432        L->m[i].Copy(h);
7433    }
7434  }
7435  res->data=(char *)L;
7436  return FALSE;
7437}
7438static BOOLEAN jjNAMES0(leftv res, leftv)
7439{
7440  res->data=(void *)ipNameList(IDROOT);
7441  return FALSE;
7442}
7443static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7444{
7445  if(v==NULL)
7446  {
7447    res->data=(char *)showOption();
7448    return FALSE;
7449  }
7450  res->rtyp=NONE;
7451  return setOption(res,v);
7452}
7453static BOOLEAN jjREDUCE4(leftv res, leftv u)
7454{
7455  leftv u1=u;
7456  leftv u2=u1->next;
7457  leftv u3=u2->next;
7458  leftv u4=u3->next;
7459  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7460  {
7461    int save_d=Kstd1_deg;
7462    Kstd1_deg=(int)(long)u3->Data();
7463    kModW=(intvec *)u4->Data();
7464    BITSET save2;
7465    SI_SAVE_OPT2(save2);
7466    si_opt_2|=Sy_bit(V_DEG_STOP);
7467    u2->next=NULL;
7468    BOOLEAN r=jjCALL2ARG(res,u);
7469    kModW=NULL;
7470    Kstd1_deg=save_d;
7471    SI_RESTORE_OPT2(save2);
7472    u->next->next=u3;
7473    return r;
7474  }
7475  else
7476  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7477     (u4->Typ()==INT_CMD))
7478  {
7479    assumeStdFlag(u3);
7480    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7481    {
7482      WerrorS("2nd argument must be a diagonal matrix of units");
7483      return TRUE;
7484    }
7485    res->rtyp=IDEAL_CMD;
7486    res->data=(char*)redNF(
7487                           idCopy((ideal)u3->Data()),
7488                           idCopy((ideal)u1->Data()),
7489                           mp_Copy((matrix)u2->Data(), currRing),
7490                           (int)(long)u4->Data()
7491                          );
7492    return FALSE;
7493  }
7494  else
7495  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7496     (u4->Typ()==INT_CMD))
7497  {
7498    assumeStdFlag(u3);
7499    if(!pIsUnit((poly)u2->Data()))
7500    {
7501      WerrorS("2nd argument must be a unit");
7502      return TRUE;
7503    }
7504    res->rtyp=POLY_CMD;
7505    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7506                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7507    return FALSE;
7508  }
7509  else
7510  {
7511    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7512    return TRUE;
7513  }
7514}
7515static BOOLEAN jjREDUCE5(leftv res, leftv u)
7516{
7517  leftv u1=u;
7518  leftv u2=u1->next;
7519  leftv u3=u2->next;
7520  leftv u4=u3->next;
7521  leftv u5=u4->next;
7522  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7523     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7524  {
7525    assumeStdFlag(u3);
7526    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7527    {
7528      WerrorS("2nd argument must be a diagonal matrix of units");
7529      return TRUE;
7530    }
7531    res->rtyp=IDEAL_CMD;
7532    res->data=(char*)redNF(
7533                           idCopy((ideal)u3->Data()),
7534                           idCopy((ideal)u1->Data()),
7535                           mp_Copy((matrix)u2->Data(),currRing),
7536                           (int)(long)u4->Data(),
7537                           (intvec*)u5->Data()
7538                          );
7539    return FALSE;
7540  }
7541  else
7542  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7543     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7544  {
7545    assumeStdFlag(u3);
7546    if(!pIsUnit((poly)u2->Data()))
7547    {
7548      WerrorS("2nd argument must be a unit");
7549      return TRUE;
7550    }
7551    res->rtyp=POLY_CMD;
7552    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7553                           pCopy((poly)u2->Data()),
7554                           (int)(long)u4->Data(),(intvec*)u5->Data());
7555    return FALSE;
7556  }
7557  else
7558  {
7559    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7560           Tok2Cmdname(iiOp));
7561    return TRUE;
7562  }
7563}
7564static BOOLEAN jjRESERVED0(leftv, leftv)
7565{
7566  int i=1;
7567  int nCount = (sArithBase.nCmdUsed-1)/3;
7568  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7569  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7570  //      sArithBase.nCmdAllocated);
7571  for(i=0; i<nCount; i++)
7572  {
7573    Print("%-20s",sArithBase.sCmds[i+1].name);
7574    if(i+1+nCount<sArithBase.nCmdUsed)
7575      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7576    if(i+1+2*nCount<sArithBase.nCmdUsed)
7577      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7578    //if ((i%3)==1) PrintLn();
7579    PrintLn();
7580  }
7581  PrintLn();
7582  printBlackboxTypes();
7583  return FALSE;
7584}
7585static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7586{
7587  if (v == NULL)
7588  {
7589    res->data = omStrDup("");
7590    return FALSE;
7591  }
7592  int n = v->listLength();
7593  if (n == 1)
7594  {
7595    res->data = v->String();
7596    return FALSE;
7597  }
7598
7599  char** slist = (char**) omAlloc(n*sizeof(char*));
7600  int i, j;
7601
7602  for (i=0, j=0; i<n; i++, v = v ->next)
7603  {
7604    slist[i] = v->String();
7605    assume(slist[i] != NULL);
7606    j+=strlen(slist[i]);
7607  }
7608  char* s = (char*) omAlloc((j+1)*sizeof(char));
7609  *s='\0';
7610  for (i=0;i<n;i++)
7611  {
7612    strcat(s, slist[i]);
7613    omFree(slist[i]);
7614  }
7615  omFreeSize(slist, n*sizeof(char*));
7616  res->data = s;
7617  return FALSE;
7618}
7619static BOOLEAN jjTEST(leftv, leftv v)
7620{
7621  do
7622  {
7623    if (v->Typ()!=INT_CMD)
7624      return TRUE;
7625    test_cmd((int)(long)v->Data());
7626    v=v->next;
7627  }
7628  while (v!=NULL);
7629  return FALSE;
7630}
7631
7632#if defined(__alpha) && !defined(linux)
7633extern "C"
7634{
7635  void usleep(unsigned long usec);
7636};
7637#endif
7638static BOOLEAN jjFactModD_M(leftv res, leftv v)
7639{
7640  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7641     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
7642
7643     valid argument lists:
7644     - (poly h, int d),
7645     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7646     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7647                                                          in list of ring vars,
7648     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7649                                                optional: all 4 optional args
7650     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7651      by singclap_factorize and h(0, y)
7652      has exactly two distinct monic factors [possibly with exponent > 1].)
7653     result:
7654     - list with the two factors f and g such that
7655       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7656
7657  poly h      = NULL;
7658  int  d      =    1;
7659  poly f0     = NULL;
7660  poly g0     = NULL;
7661  int  xIndex =    1;   /* default index if none provided */
7662  int  yIndex =    2;   /* default index if none provided */
7663
7664  leftv u = v; int factorsGiven = 0;
7665  if ((u == NULL) || (u->Typ() != POLY_CMD))
7666  {
7667    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7668    return TRUE;
7669  }
7670  else h = (poly)u->Data();
7671  u = u->next;
7672  if ((u == NULL) || (u->Typ() != INT_CMD))
7673  {
7674    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7675    return TRUE;
7676  }
7677  else d = (int)(long)u->Data();
7678  u = u->next;
7679  if ((u != NULL) && (u->Typ() == POLY_CMD))
7680  {
7681    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7682    {
7683      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7684      return TRUE;
7685    }
7686    else
7687    {
7688      f0 = (poly)u->Data();
7689      g0 = (poly)u->next->Data();
7690      factorsGiven = 1;
7691      u = u->next->next;
7692    }
7693  }
7694  if ((u != NULL) && (u->Typ() == INT_CMD))
7695  {
7696    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7697    {
7698      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7699      return TRUE;
7700    }
7701    else
7702    {
7703      xIndex = (int)(long)u->Data();
7704      yIndex = (int)(long)u->next->Data();
7705      u = u->next->next;
7706    }
7707  }
7708  if (u != NULL)
7709  {
7710    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7711    return TRUE;
7712  }
7713
7714  /* checks for provided arguments */
7715  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7716  {
7717    WerrorS("expected non-constant polynomial argument(s)");
7718    return TRUE;
7719  }
7720  int n = rVar(currRing);
7721  if ((xIndex < 1) || (n < xIndex))
7722  {
7723    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7724    return TRUE;
7725  }
7726  if ((yIndex < 1) || (n < yIndex))
7727  {
7728    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7729    return TRUE;
7730  }
7731  if (xIndex == yIndex)
7732  {
7733    WerrorS("expected distinct indices for variables x and y");
7734    return TRUE;
7735  }
7736
7737  /* computation of f0 and g0 if missing */
7738  if (factorsGiven == 0)
7739  {
7740    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7741    intvec* v = NULL;
7742    ideal i = singclap_factorize(h0, &v, 0,currRing);
7743
7744    ivTest(v);
7745
7746    if (i == NULL) return TRUE;
7747
7748    idTest(i);
7749
7750    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7751    {
7752      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7753      return TRUE;
7754    }
7755    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7756    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7757    idDelete(&i);
7758  }
7759
7760  poly f; poly g;
7761  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7762  lists L = (lists)omAllocBin(slists_bin);
7763  L->Init(2);
7764  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7765  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7766  res->rtyp = LIST_CMD;
7767  res->data = (char*)L;
7768  return FALSE;
7769}
7770static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7771{
7772  if ((v->Typ() != LINK_CMD) ||
7773      (v->next->Typ() != STRING_CMD) ||
7774      (v->next->next->Typ() != STRING_CMD) ||
7775      (v->next->next->next->Typ() != INT_CMD))
7776    return TRUE;
7777  jjSTATUS3(res, v, v->next, v->next->next);
7778#if defined(HAVE_USLEEP)
7779  if (((long) res->data) == 0L)
7780  {
7781    int i_s = (int)(long) v->next->next->next->Data();
7782    if (i_s > 0)
7783    {
7784      usleep((int)(long) v->next->next->next->Data());
7785      jjSTATUS3(res, v, v->next, v->next->next);
7786    }
7787  }
7788#elif defined(HAVE_SLEEP)
7789  if (((int) res->data) == 0)
7790  {
7791    int i_s = (int) v->next->next->next->Data();
7792    if (i_s > 0)
7793    {
7794      si_sleep((is - 1)/1000000 + 1);
7795      jjSTATUS3(res, v, v->next, v->next->next);
7796    }
7797  }
7798#endif
7799  return FALSE;
7800}
7801static BOOLEAN jjSUBST_M(leftv res, leftv u)
7802{
7803  leftv v = u->next; // number of args > 0
7804  if (v==NULL) return TRUE;
7805  leftv w = v->next;
7806  if (w==NULL) return TRUE;
7807  leftv rest = w->next;;
7808
7809  u->next = NULL;
7810  v->next = NULL;
7811  w->next = NULL;
7812  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7813  if ((rest!=NULL) && (!b))
7814  {
7815    sleftv tmp_res;
7816    leftv tmp_next=res->next;
7817    res->next=rest;
7818    memset(&tmp_res,0,sizeof(tmp_res));
7819    b = iiExprArithM(&tmp_res,res,iiOp);
7820    memcpy(res,&tmp_res,sizeof(tmp_res));
7821    res->next=tmp_next;
7822  }
7823  u->next = v;
7824  v->next = w;
7825  // rest was w->next, but is already cleaned
7826  return b;
7827}
7828static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7829{
7830  if ((INPUT->Typ() != MATRIX_CMD) ||
7831      (INPUT->next->Typ() != NUMBER_CMD) ||
7832      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7833      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7834  {
7835    WerrorS("expected (matrix, number, number, number) as arguments");
7836    return TRUE;
7837  }
7838  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7839  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7840                                    (number)(v->Data()),
7841                                    (number)(w->Data()),
7842                                    (number)(x->Data()));
7843  return FALSE;
7844}
7845static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7846{ ideal result;
7847  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7848  leftv v = u->next;  /* one additional polynomial or ideal */
7849  leftv h = v->next;  /* Hilbert vector */
7850  leftv w = h->next;  /* weight vector */
7851  assumeStdFlag(u);
7852  ideal i1=(ideal)(u->Data());
7853  ideal i0;
7854  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7855  || (h->Typ()!=INTVEC_CMD)
7856  || (w->Typ()!=INTVEC_CMD))
7857  {
7858    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7859    return TRUE;
7860  }
7861  intvec *vw=(intvec *)w->Data(); // weights of vars
7862  /* merging std_hilb_w and std_1 */
7863  if (vw->length()!=currRing->N)
7864  {
7865    Werror("%d weights for %d variables",vw->length(),currRing->N);
7866    return TRUE;
7867  }
7868  int r=v->Typ();
7869  BOOLEAN cleanup_i0=FALSE;
7870  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7871  {
7872    i0=idInit(1,i1->rank);
7873    i0->m[0]=(poly)v->Data();
7874    cleanup_i0=TRUE;
7875  }
7876  else if (r==IDEAL_CMD)/* IDEAL */
7877  {
7878    i0=(ideal)v->Data();
7879  }
7880  else
7881  {
7882    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7883    return TRUE;
7884  }
7885  int ii0=idElem(i0);
7886  i1 = idSimpleAdd(i1,i0);
7887  if (cleanup_i0)
7888  {
7889    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7890    idDelete(&i0);
7891  }
7892  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7893  tHomog hom=testHomog;
7894  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7895  if (ww!=NULL)
7896  {
7897    if (!idTestHomModule(i1,currRing->qideal,ww))
7898    {
7899      WarnS("wrong weights");
7900      ww=NULL;
7901    }
7902    else
7903    {
7904      ww=ivCopy(ww);
7905      hom=isHomog;
7906    }
7907  }
7908  BITSET save1;
7909  SI_SAVE_OPT1(save1);
7910  si_opt_1|=Sy_bit(OPT_SB_1);
7911  result=kStd(i1,
7912              currRing->qideal,
7913              hom,
7914              &ww,                  // module weights
7915              (intvec *)h->Data(),  // hilbert series
7916              0,                    // syzComp, whatever it is...
7917              IDELEMS(i1)-ii0,      // new ideal
7918              vw);                  // weights of vars
7919  SI_RESTORE_OPT1(save1);
7920  idDelete(&i1);
7921  idSkipZeroes(result);
7922  res->data = (char *)result;
7923  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7924  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7925  return FALSE;
7926}
7927
7928
7929static Subexpr jjMakeSub(leftv e)
7930{
7931  assume( e->Typ()==INT_CMD );
7932  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7933  r->start =(int)(long)e->Data();
7934  return r;
7935}
7936#define D(A)    (A)
7937#define NULL_VAL NULL
7938#define IPARITH
7939#include "table.h"
7940
7941#include "iparith.inc"
7942
7943/*=================== operations with 2 args. ============================*/
7944/* must be ordered: first operations for chars (infix ops),
7945 * then alphabetically */
7946
7947static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
7948                                    BOOLEAN proccall,
7949                                    struct sValCmd2* dA2,
7950                                    int at, int bt,
7951                                    struct sConvertTypes *dConvertTypes)
7952{
7953  memset(res,0,sizeof(sleftv));
7954  BOOLEAN call_failed=FALSE;
7955
7956  if (!errorreported)
7957  {
7958    int i=0;
7959    iiOp=op;
7960    while (dA2[i].cmd==op)
7961    {
7962      if ((at==dA2[i].arg1)
7963      && (bt==dA2[i].arg2))
7964      {
7965        res->rtyp=dA2[i].res;
7966        if (currRing!=NULL)
7967        {
7968          if (check_valid(dA2[i].valid_for,op)) break;
7969        }
7970        else
7971        {
7972          if (RingDependend(dA2[i].res))
7973          {
7974            WerrorS("no ring active");
7975            break;
7976          }
7977        }
7978        if (traceit&TRACE_CALL)
7979          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7980        if ((call_failed=dA2[i].p(res,a,b)))
7981        {
7982          break;// leave loop, goto error handling
7983        }
7984        a->CleanUp();
7985        b->CleanUp();
7986        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7987        return FALSE;
7988      }
7989      i++;
7990    }
7991    // implicite type conversion ----------------------------------------------
7992    if (dA2[i].cmd!=op)
7993    {
7994      int ai,bi;
7995      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7996      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7997      BOOLEAN failed=FALSE;
7998      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7999      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8000      while (dA2[i].cmd==op)
8001      {
8002        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8003        if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8004        {
8005          if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8006          {
8007            res->rtyp=dA2[i].res;
8008            if (currRing!=NULL)
8009            {
8010              if (check_valid(dA2[i].valid_for,op)) break;
8011            }
8012            else
8013            {
8014              if (RingDependend(dA2[i].res))
8015              {
8016                WerrorS("no ring active");
8017                break;
8018              }
8019            }
8020            if (traceit&TRACE_CALL)
8021              Print("call %s(%s,%s)\n",iiTwoOps(op),
8022              Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8023            failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8024            || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8025            || (call_failed=dA2[i].p(res,an,bn)));
8026            // everything done, clean up temp. variables
8027            if (failed)
8028            {
8029              // leave loop, goto error handling
8030              break;
8031            }
8032            else
8033            {
8034              // everything ok, clean up and return
8035              an->CleanUp();
8036              bn->CleanUp();
8037              omFreeBin((ADDRESS)an, sleftv_bin);
8038              omFreeBin((ADDRESS)bn, sleftv_bin);
8039              a->CleanUp();
8040              b->CleanUp();
8041              return FALSE;
8042            }
8043          }
8044        }
8045        i++;
8046      }
8047      an->CleanUp();
8048      bn->CleanUp();
8049      omFreeBin((ADDRESS)an, sleftv_bin);
8050      omFreeBin((ADDRESS)bn, sleftv_bin);
8051    }
8052    // error handling ---------------------------------------------------
8053    const char *s=NULL;
8054    if (!errorreported)
8055    {
8056      if ((at==0) && (a->Fullname()!=sNoName))
8057      {
8058        s=a->Fullname();
8059      }
8060      else if ((bt==0) && (b->Fullname()!=sNoName))
8061      {
8062        s=b->Fullname();
8063      }
8064      if (s!=NULL)
8065        Werror("`%s` is not defined",s);
8066      else
8067      {
8068        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8069        s = iiTwoOps(op);
8070        if (proccall)
8071        {
8072          Werror("%s(`%s`,`%s`) failed"
8073                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8074        }
8075        else
8076        {
8077          Werror("`%s` %s `%s` failed"
8078                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8079        }
8080        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8081        {
8082          while (dA2[i].cmd==op)
8083          {
8084            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8085            && (dA2[i].res!=0)
8086            && (dA2[i].p!=jjWRONG2))
8087            {
8088              if (proccall)
8089                Werror("expected %s(`%s`,`%s`)"
8090                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8091              else
8092                Werror("expected `%s` %s `%s`"
8093                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8094            }
8095            i++;
8096          }
8097        }
8098      }
8099    }
8100    res->rtyp = UNKNOWN;
8101  }
8102  a->CleanUp();
8103  b->CleanUp();
8104  return TRUE;
8105}
8106BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8107                                    struct sValCmd2* dA2,
8108                                    int at,
8109                                    struct sConvertTypes *dConvertTypes)
8110{
8111  leftv b=a->next;
8112  a->next=NULL;
8113  int bt=b->Typ();
8114  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8115  a->next=b;
8116  a->CleanUp();
8117  return bo;
8118}
8119BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8120{
8121  memset(res,0,sizeof(sleftv));
8122
8123  if (!errorreported)
8124  {
8125#ifdef SIQ
8126    if (siq>0)
8127    {
8128      //Print("siq:%d\n",siq);
8129      command d=(command)omAlloc0Bin(sip_command_bin);
8130      memcpy(&d->arg1,a,sizeof(sleftv));
8131      //a->Init();
8132      memcpy(&d->arg2,b,sizeof(sleftv));
8133      //b->Init();
8134      d->argc=2;
8135      d->op=op;
8136      res->data=(char *)d;
8137      res->rtyp=COMMAND;
8138      return FALSE;
8139    }
8140#endif
8141    int at=a->Typ();
8142    int bt=b->Typ();
8143    // handling bb-objects ----------------------------------------------------
8144    if (at>MAX_TOK)
8145    {
8146      blackbox *bb=getBlackboxStuff(at);
8147      if (bb!=NULL)
8148      {
8149        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8150        if (errorreported) return TRUE;
8151        // else: no op defined
8152      }
8153      else          return TRUE;
8154    }
8155    else if ((bt>MAX_TOK)&&(op!='('))
8156    {
8157      blackbox *bb=getBlackboxStuff(bt);
8158      if (bb!=NULL)
8159      {
8160        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8161        if (errorreported) return TRUE;
8162        // else: no op defined
8163      }
8164      else          return TRUE;
8165    }
8166    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8167    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8168  }
8169  a->CleanUp();
8170  b->CleanUp();
8171  return TRUE;
8172}
8173
8174/*==================== operations with 1 arg. ===============================*/
8175/* must be ordered: first operations for chars (infix ops),
8176 * then alphabetically */
8177
8178BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, struct sValCmd1* dA1, int at, struct sConvertTypes *dConvertTypes)
8179{
8180  memset(res,0,sizeof(sleftv));
8181  BOOLEAN call_failed=FALSE;
8182
8183  if (!errorreported)
8184  {
8185    BOOLEAN failed=FALSE;
8186    iiOp=op;
8187    int i = 0;
8188    while (dA1[i].cmd==op)
8189    {
8190      if (at==dA1[i].arg)
8191      {
8192        if (currRing!=NULL)
8193        {
8194          if (check_valid(dA1[i].valid_for,op)) break;
8195        }
8196        else
8197        {
8198          if (RingDependend(dA1[i].res))
8199          {
8200            WerrorS("no ring active");
8201            break;
8202          }
8203        }
8204        if (traceit&TRACE_CALL)
8205          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8206        res->rtyp=dA1[i].res;
8207        if ((call_failed=dA1[i].p(res,a)))
8208        {
8209          break;// leave loop, goto error handling
8210        }
8211        if (a->Next()!=NULL)
8212        {
8213          res->next=(leftv)omAllocBin(sleftv_bin);
8214          failed=iiExprArith1(res->next,a->next,op);
8215        }
8216        a->CleanUp();
8217        return failed;
8218      }
8219      i++;
8220    }
8221    // implicite type conversion --------------------------------------------
8222    if (dA1[i].cmd!=op)
8223    {
8224      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8225      i=0;
8226      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8227      while (dA1[i].cmd==op)
8228      {
8229        int ai;
8230        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8231        if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8232        {
8233          if (currRing!=NULL)
8234          {
8235            if (check_valid(dA1[i].valid_for,op)) break;
8236          }
8237          else
8238          {
8239            if (RingDependend(dA1[i].res))
8240            {
8241              WerrorS("no ring active");
8242              break;
8243            }
8244          }
8245          if (traceit&TRACE_CALL)
8246            Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8247          res->rtyp=dA1[i].res;
8248          failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8249          || (call_failed=dA1[i].p(res,an)));
8250          // everything done, clean up temp. variables
8251          if (failed)
8252          {
8253            // leave loop, goto error handling
8254            break;
8255          }
8256          else
8257          {
8258            if (an->Next() != NULL)
8259            {
8260              res->next = (leftv)omAllocBin(sleftv_bin);
8261              failed=iiExprArith1(res->next,an->next,op);
8262            }
8263            // everything ok, clean up and return
8264            an->CleanUp();
8265            omFreeBin((ADDRESS)an, sleftv_bin);
8266            a->CleanUp();
8267            return failed;
8268          }
8269        }
8270        i++;
8271      }
8272      an->CleanUp();
8273      omFreeBin((ADDRESS)an, sleftv_bin);
8274    }
8275    // error handling
8276    if (!errorreported)
8277    {
8278      if ((at==0) && (a->Fullname()!=sNoName))
8279      {
8280        Werror("`%s` is not defined",a->Fullname());
8281      }
8282      else
8283      {
8284        i=0;
8285        const char *s = iiTwoOps(op);
8286        Werror("%s(`%s`) failed"
8287                ,s,Tok2Cmdname(at));
8288        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8289        {
8290          while (dA1[i].cmd==op)
8291          {
8292            if ((dA1[i].res!=0)
8293            && (dA1[i].p!=jjWRONG))
8294              Werror("expected %s(`%s`)"
8295                ,s,Tok2Cmdname(dA1[i].arg));
8296            i++;
8297          }
8298        }
8299      }
8300    }
8301    res->rtyp = UNKNOWN;
8302  }
8303  a->CleanUp();
8304  return TRUE;
8305}
8306BOOLEAN iiExprArith1(leftv res, leftv a, int op)
8307{
8308  memset(res,0,sizeof(sleftv));
8309
8310  if (!errorreported)
8311  {
8312#ifdef SIQ
8313    if (siq>0)
8314    {
8315      //Print("siq:%d\n",siq);
8316      command d=(command)omAlloc0Bin(sip_command_bin);
8317      memcpy(&d->arg1,a,sizeof(sleftv));
8318      //a->Init();
8319      d->op=op;
8320      d->argc=1;
8321      res->data=(char *)d;
8322      res->rtyp=COMMAND;
8323      return FALSE;
8324    }
8325#endif
8326    int at=a->Typ();
8327    // handling bb-objects ----------------------------------------------------
8328    if(op>MAX_TOK) // explicit type conversion to bb
8329    {
8330      blackbox *bb=getBlackboxStuff(op);
8331      if (bb!=NULL)
8332      {
8333        res->rtyp=op;
8334        res->data=bb->blackbox_Init(bb);
8335        if(!bb->blackbox_Assign(res,a)) return FALSE;
8336        if (errorreported) return TRUE;
8337      }
8338      else          return TRUE;
8339    }
8340    else if (at>MAX_TOK) // argument is of bb-type
8341    {
8342      blackbox *bb=getBlackboxStuff(at);
8343      if (bb!=NULL)
8344      {
8345        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
8346        if (errorreported) return TRUE;
8347        // else: no op defined
8348      }
8349      else          return TRUE;
8350    }
8351
8352    iiOp=op;
8353    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8354    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
8355  }
8356  a->CleanUp();
8357  return TRUE;
8358}
8359
8360/*=================== operations with 3 args. ============================*/
8361/* must be ordered: first operations for chars (infix ops),
8362 * then alphabetically */
8363
8364static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
8365  struct sValCmd3* dA3, int at, int bt, int ct,
8366  struct sConvertTypes *dConvertTypes)
8367{
8368  memset(res,0,sizeof(sleftv));
8369  BOOLEAN call_failed=FALSE;
8370
8371  assume(dA3[0].cmd==op);
8372
8373  if (!errorreported)
8374  {
8375    int i=0;
8376    iiOp=op;
8377    while (dA3[i].cmd==op)
8378    {
8379      if ((at==dA3[i].arg1)
8380      && (bt==dA3[i].arg2)
8381      && (ct==dA3[i].arg3))
8382      {
8383        res->rtyp=dA3[i].res;
8384        if (currRing!=NULL)
8385        {
8386          if (check_valid(dA3[i].valid_for,op)) break;
8387        }
8388        if (traceit&TRACE_CALL)
8389          Print("call %s(%s,%s,%s)\n",
8390            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8391        if ((call_failed=dA3[i].p(res,a,b,c)))
8392        {
8393          break;// leave loop, goto error handling
8394        }
8395        a->CleanUp();
8396        b->CleanUp();
8397        c->CleanUp();
8398        return FALSE;
8399      }
8400      i++;
8401    }
8402    // implicite type conversion ----------------------------------------------
8403    if (dA3[i].cmd!=op)
8404    {
8405      int ai,bi,ci;
8406      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8407      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8408      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8409      BOOLEAN failed=FALSE;
8410      i=0;
8411      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8412      while (dA3[i].cmd==op)
8413      {
8414        if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
8415        {
8416          if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
8417          {
8418            if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
8419            {
8420              res->rtyp=dA3[i].res;
8421              if (currRing!=NULL)
8422              {
8423                if (check_valid(dA3[i].valid_for,op)) break;
8424              }
8425              if (traceit&TRACE_CALL)
8426                Print("call %s(%s,%s,%s)\n",
8427                  iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
8428                  Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
8429              failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
8430                || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
8431                || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
8432                || (call_failed=dA3[i].p(res,an,bn,cn)));
8433              // everything done, clean up temp. variables
8434              if (failed)
8435              {
8436                // leave loop, goto error handling
8437                break;
8438              }
8439              else
8440              {
8441                // everything ok, clean up and return
8442                an->CleanUp();
8443                bn->CleanUp();
8444                cn->CleanUp();
8445                omFreeBin((ADDRESS)an, sleftv_bin);
8446                omFreeBin((ADDRESS)bn, sleftv_bin);
8447                omFreeBin((ADDRESS)cn, sleftv_bin);
8448                a->CleanUp();
8449                b->CleanUp();
8450                c->CleanUp();
8451        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8452                return FALSE;
8453              }
8454            }
8455          }
8456        }
8457        i++;
8458      }
8459      an->CleanUp();
8460      bn->CleanUp();
8461      cn->CleanUp();
8462      omFreeBin((ADDRESS)an, sleftv_bin);
8463      omFreeBin((ADDRESS)bn, sleftv_bin);
8464      omFreeBin((ADDRESS)cn, sleftv_bin);
8465    }
8466    // error handling ---------------------------------------------------
8467    if (!errorreported)
8468    {
8469      const char *s=NULL;
8470      if ((at==0) && (a->Fullname()!=sNoName))
8471      {
8472        s=a->Fullname();
8473      }
8474      else if ((bt==0) && (b->Fullname()!=sNoName))
8475      {
8476        s=b->Fullname();
8477      }
8478      else if ((ct==0) && (c->Fullname()!=sNoName))
8479      {
8480        s=c->Fullname();
8481      }
8482      if (s!=NULL)
8483        Werror("`%s` is not defined",s);
8484      else
8485      {
8486        i=0;
8487        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8488        const char *s = iiTwoOps(op);
8489        Werror("%s(`%s`,`%s`,`%s`) failed"
8490                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8491        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8492        {
8493          while (dA3[i].cmd==op)
8494          {
8495            if(((at==dA3[i].arg1)
8496            ||(bt==dA3[i].arg2)
8497            ||(ct==dA3[i].arg3))
8498            && (dA3[i].res!=0))
8499            {
8500              Werror("expected %s(`%s`,`%s`,`%s`)"
8501                  ,s,Tok2Cmdname(dA3[i].arg1)
8502                  ,Tok2Cmdname(dA3[i].arg2)
8503                  ,Tok2Cmdname(dA3[i].arg3));
8504            }
8505            i++;
8506          }
8507        }
8508      }
8509    }
8510    res->rtyp = UNKNOWN;
8511  }
8512  a->CleanUp();
8513  b->CleanUp();
8514  c->CleanUp();
8515        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8516  return TRUE;
8517}
8518BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8519{
8520  memset(res,0,sizeof(sleftv));
8521
8522  if (!errorreported)
8523  {
8524#ifdef SIQ
8525    if (siq>0)
8526    {
8527      //Print("siq:%d\n",siq);
8528      command d=(command)omAlloc0Bin(sip_command_bin);
8529      memcpy(&d->arg1,a,sizeof(sleftv));
8530      //a->Init();
8531      memcpy(&d->arg2,b,sizeof(sleftv));
8532      //b->Init();
8533      memcpy(&d->arg3,c,sizeof(sleftv));
8534      //c->Init();
8535      d->op=op;
8536      d->argc=3;
8537      res->data=(char *)d;
8538      res->rtyp=COMMAND;
8539      return FALSE;
8540    }
8541#endif
8542    int at=a->Typ();
8543    // handling bb-objects ----------------------------------------------
8544    if (at>MAX_TOK)
8545    {
8546      blackbox *bb=getBlackboxStuff(at);
8547      if (bb!=NULL)
8548      {
8549        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8550        if (errorreported) return TRUE;
8551        // else: no op defined
8552      }
8553      else          return TRUE;
8554      if (errorreported) return TRUE;
8555    }
8556    int bt=b->Typ();
8557    int ct=c->Typ();
8558
8559    iiOp=op;
8560    int i=0;
8561    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8562    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8563  }
8564  a->CleanUp();
8565  b->CleanUp();
8566  c->CleanUp();
8567        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8568  return TRUE;
8569}
8570BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
8571                                    struct sValCmd3* dA3,
8572                                    int at,
8573                                    struct sConvertTypes *dConvertTypes)
8574{
8575  leftv b=a->next;
8576  a->next=NULL;
8577  int bt=b->Typ();
8578  leftv c=b->next;
8579  b->next=NULL;
8580  int ct=c->Typ();
8581  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8582  b->next=c;
8583  a->next=b;
8584  a->CleanUp();
8585  return bo;
8586}
8587/*==================== operations with many arg. ===============================*/
8588/* must be ordered: first operations for chars (infix ops),
8589 * then alphabetically */
8590
8591BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8592{
8593  // cnt = 0: all
8594  // cnt = 1: only first one
8595  leftv next;
8596  BOOLEAN failed = TRUE;
8597  if(v==NULL) return failed;
8598  res->rtyp = LIST_CMD;
8599  if(cnt) v->next = NULL;
8600  next = v->next;             // saving next-pointer
8601  failed = jjLIST_PL(res, v);
8602  v->next = next;             // writeback next-pointer
8603  return failed;
8604}
8605
8606BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8607{
8608  memset(res,0,sizeof(sleftv));
8609
8610  if (!errorreported)
8611  {
8612#ifdef SIQ
8613    if (siq>0)
8614    {
8615      //Print("siq:%d\n",siq);
8616      command d=(command)omAlloc0Bin(sip_command_bin);
8617      d->op=op;
8618      res->data=(char *)d;
8619      if (a!=NULL)
8620      {
8621        d->argc=a->listLength();
8622        // else : d->argc=0;
8623        memcpy(&d->arg1,a,sizeof(sleftv));
8624        switch(d->argc)
8625        {
8626          case 3:
8627            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8628            a->next->next->Init();
8629            /* no break */
8630          case 2:
8631            memcpy(&d->arg2,a->next,sizeof(sleftv));
8632            a->next->Init();
8633            a->next->next=d->arg2.next;
8634            d->arg2.next=NULL;
8635            /* no break */
8636          case 1:
8637            a->Init();
8638            a->next=d->arg1.next;
8639            d->arg1.next=NULL;
8640        }
8641        if (d->argc>3) a->next=NULL;
8642        a->name=NULL;
8643        a->rtyp=0;
8644        a->data=NULL;
8645        a->e=NULL;
8646        a->attribute=NULL;
8647        a->CleanUp();
8648      }
8649      res->rtyp=COMMAND;
8650      return FALSE;
8651    }
8652#endif
8653    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8654    {
8655      blackbox *bb=getBlackboxStuff(a->Typ());
8656      if (bb!=NULL)
8657      {
8658        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
8659        if (errorreported) return TRUE;
8660        // else: no op defined
8661      }
8662      else          return TRUE;
8663    }
8664    BOOLEAN failed=FALSE;
8665    int args=0;
8666    if (a!=NULL) args=a->listLength();
8667
8668    iiOp=op;
8669    int i=0;
8670    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8671    while (dArithM[i].cmd==op)
8672    {
8673      if ((args==dArithM[i].number_of_args)
8674      || (dArithM[i].number_of_args==-1)
8675      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8676      {
8677        res->rtyp=dArithM[i].res;
8678        if (currRing!=NULL)
8679        {
8680          if (check_valid(dArithM[i].valid_for,op)) break;
8681        }
8682        if (traceit&TRACE_CALL)
8683          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8684        if ((failed=dArithM[i].p(res,a))==TRUE)
8685        {
8686          break;// leave loop, goto error handling
8687        }
8688        if (a!=NULL) a->CleanUp();
8689        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8690        return failed;
8691      }
8692      i++;
8693    }
8694    // error handling
8695    if (!errorreported)
8696    {
8697      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8698      {
8699        Werror("`%s` is not defined",a->Fullname());
8700      }
8701      else
8702      {
8703        const char *s = iiTwoOps(op);
8704        Werror("%s(...) failed",s);
8705      }
8706    }
8707    res->rtyp = UNKNOWN;
8708  }
8709  if (a!=NULL) a->CleanUp();
8710        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8711  return TRUE;
8712}
8713
8714/*=================== general utilities ============================*/
8715int IsCmd(const char *n, int & tok)
8716{
8717  int i;
8718  int an=1;
8719  int en=sArithBase.nLastIdentifier;
8720
8721  loop
8722  //for(an=0; an<sArithBase.nCmdUsed; )
8723  {
8724    if(an>=en-1)
8725    {
8726      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8727      {
8728        i=an;
8729        break;
8730      }
8731      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8732      {
8733        i=en;
8734        break;
8735      }
8736      else
8737      {
8738        // -- blackbox extensions:
8739        // return 0;
8740        return blackboxIsCmd(n,tok);
8741      }
8742    }
8743    i=(an+en)/2;
8744    if (*n < *(sArithBase.sCmds[i].name))
8745    {
8746      en=i-1;
8747    }
8748    else if (*n > *(sArithBase.sCmds[i].name))
8749    {
8750      an=i+1;
8751    }
8752    else
8753    {
8754      int v=strcmp(n,sArithBase.sCmds[i].name);
8755      if(v<0)
8756      {
8757        en=i-1;
8758      }
8759      else if(v>0)
8760      {
8761        an=i+1;
8762      }
8763      else /*v==0*/
8764      {
8765        break;
8766      }
8767    }
8768  }
8769  lastreserved=sArithBase.sCmds[i].name;
8770  tok=sArithBase.sCmds[i].tokval;
8771  if(sArithBase.sCmds[i].alias==2)
8772  {
8773    Warn("outdated identifier `%s` used - please change your code",
8774    sArithBase.sCmds[i].name);
8775    sArithBase.sCmds[i].alias=1;
8776  }
8777  #if 0
8778  if (currRingHdl==NULL)
8779  {
8780    #ifdef SIQ
8781    if (siq<=0)
8782    {
8783    #endif
8784      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8785      {
8786        WerrorS("no ring active");
8787        return 0;
8788      }
8789    #ifdef SIQ
8790    }
8791    #endif
8792  }
8793  #endif
8794  if (!expected_parms)
8795  {
8796    switch (tok)
8797    {
8798      case IDEAL_CMD:
8799      case INT_CMD:
8800      case INTVEC_CMD:
8801      case MAP_CMD:
8802      case MATRIX_CMD:
8803      case MODUL_CMD:
8804      case POLY_CMD:
8805      case PROC_CMD:
8806      case RING_CMD:
8807      case STRING_CMD:
8808        cmdtok = tok;
8809        break;
8810    }
8811  }
8812  return sArithBase.sCmds[i].toktype;
8813}
8814static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8815{
8816  // user defined types are not in the pre-computed table:
8817  if (op>MAX_TOK) return 0;
8818
8819  int a=0;
8820  int e=len;
8821  int p=len/2;
8822  do
8823  {
8824     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8825     if (op<dArithTab[p].cmd) e=p-1;
8826     else   a = p+1;
8827     p=a+(e-a)/2;
8828  }
8829  while ( a <= e);
8830
8831  // catch missing a cmd:
8832  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
8833  // Print("op %d (%c) unknown",op,op);
8834  return 0;
8835}
8836
8837const char * Tok2Cmdname(int tok)
8838{
8839  if (tok <= 0)
8840  {
8841    return sArithBase.sCmds[0].name;
8842  }
8843  if (tok==ANY_TYPE) return "any_type";
8844  if (tok==COMMAND) return "command";
8845  if (tok==NONE) return "nothing";
8846  //if (tok==IFBREAK) return "if_break";
8847  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8848  //if (tok==ORDER_VECTOR) return "ordering";
8849  //if (tok==REF_VAR) return "ref";
8850  //if (tok==OBJECT) return "object";
8851  //if (tok==PRINT_EXPR) return "print_expr";
8852  if (tok==IDHDL) return "identifier";
8853  if (tok==CRING_CMD) return "(c)ring";
8854  if (tok==QRING_CMD) return "ring";
8855  if (tok>MAX_TOK) return getBlackboxName(tok);
8856  int i;
8857  for(i=0; i<sArithBase.nCmdUsed; i++)
8858    //while (sArithBase.sCmds[i].tokval!=0)
8859  {
8860    if ((sArithBase.sCmds[i].tokval == tok)&&
8861        (sArithBase.sCmds[i].alias==0))
8862    {
8863      return sArithBase.sCmds[i].name;
8864    }
8865  }
8866  // try gain for alias/old names:
8867  for(i=0; i<sArithBase.nCmdUsed; i++)
8868  {
8869    if (sArithBase.sCmds[i].tokval == tok)
8870    {
8871      return sArithBase.sCmds[i].name;
8872    }
8873  }
8874  return sArithBase.sCmds[0].name;
8875}
8876
8877
8878/*---------------------------------------------------------------------*/
8879/**
8880 * @brief compares to entry of cmdsname-list
8881
8882 @param[in] a
8883 @param[in] b
8884
8885 @return <ReturnValue>
8886**/
8887/*---------------------------------------------------------------------*/
8888static int _gentable_sort_cmds( const void *a, const void *b )
8889{
8890  cmdnames *pCmdL = (cmdnames*)a;
8891  cmdnames *pCmdR = (cmdnames*)b;
8892
8893  if(a==NULL || b==NULL)             return 0;
8894
8895  /* empty entries goes to the end of the list for later reuse */
8896  if(pCmdL->name==NULL) return 1;
8897  if(pCmdR->name==NULL) return -1;
8898
8899  /* $INVALID$ must come first */
8900  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8901  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8902
8903  /* tokval=-1 are reserved names at the end */
8904  if (pCmdL->tokval==-1)
8905  {
8906    if (pCmdR->tokval==-1)
8907       return strcmp(pCmdL->name, pCmdR->name);
8908    /* pCmdL->tokval==-1, pCmdL goes at the end */
8909    return 1;
8910  }
8911  /* pCmdR->tokval==-1, pCmdR goes at the end */
8912  if(pCmdR->tokval==-1) return -1;
8913
8914  return strcmp(pCmdL->name, pCmdR->name);
8915}
8916
8917/*---------------------------------------------------------------------*/
8918/**
8919 * @brief initialisation of arithmetic structured data
8920
8921 @retval 0 on success
8922
8923**/
8924/*---------------------------------------------------------------------*/
8925int iiInitArithmetic()
8926{
8927  //printf("iiInitArithmetic()\n");
8928  memset(&sArithBase, 0, sizeof(sArithBase));
8929  iiInitCmdName();
8930  /* fix last-identifier */
8931#if 0
8932  /* we expect that gentable allready did every thing */
8933  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8934      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8935    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8936  }
8937#endif
8938  //Print("L=%d\n", sArithBase.nLastIdentifier);
8939
8940  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8941  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8942
8943  //iiArithAddCmd("Top", 0,-1,0);
8944
8945
8946  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8947  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8948  //         sArithBase.sCmds[i].name,
8949  //         sArithBase.sCmds[i].alias,
8950  //         sArithBase.sCmds[i].tokval,
8951  //         sArithBase.sCmds[i].toktype);
8952  //}
8953  //iiArithRemoveCmd("Top");
8954  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8955  //iiArithRemoveCmd("mygcd");
8956  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8957  return 0;
8958}
8959
8960int iiArithFindCmd(const char *szName)
8961{
8962  int an=0;
8963  int i = 0,v = 0;
8964  int en=sArithBase.nLastIdentifier;
8965
8966  loop
8967  //for(an=0; an<sArithBase.nCmdUsed; )
8968  {
8969    if(an>=en-1)
8970    {
8971      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8972      {
8973        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8974        return an;
8975      }
8976      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8977      {
8978        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8979        return en;
8980      }
8981      else
8982      {
8983        //Print("RET- 1\n");
8984        return -1;
8985      }
8986    }
8987    i=(an+en)/2;
8988    if (*szName < *(sArithBase.sCmds[i].name))
8989    {
8990      en=i-1;
8991    }
8992    else if (*szName > *(sArithBase.sCmds[i].name))
8993    {
8994      an=i+1;
8995    }
8996    else
8997    {
8998      v=strcmp(szName,sArithBase.sCmds[i].name);
8999      if(v<0)
9000      {
9001        en=i-1;
9002      }
9003      else if(v>0)
9004      {
9005        an=i+1;
9006      }
9007      else /*v==0*/
9008      {
9009        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9010        return i;
9011      }
9012    }
9013  }
9014  //if(i>=0 && i<sArithBase.nCmdUsed)
9015  //  return i;
9016  //Print("RET-2\n");
9017  return -2;
9018}
9019
9020char *iiArithGetCmd( int nPos )
9021{
9022  if(nPos<0) return NULL;
9023  if(nPos<sArithBase.nCmdUsed)
9024    return sArithBase.sCmds[nPos].name;
9025  return NULL;
9026}
9027
9028int iiArithRemoveCmd(const char *szName)
9029{
9030  int nIndex;
9031  if(szName==NULL) return -1;
9032
9033  nIndex = iiArithFindCmd(szName);
9034  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
9035  {
9036    Print("'%s' not found (%d)\n", szName, nIndex);
9037    return -1;
9038  }
9039  omFree(sArithBase.sCmds[nIndex].name);
9040  sArithBase.sCmds[nIndex].name=NULL;
9041  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9042        (&_gentable_sort_cmds));
9043  sArithBase.nCmdUsed--;
9044
9045  /* fix last-identifier */
9046  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9047      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9048  {
9049    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9050  }
9051  //Print("L=%d\n", sArithBase.nLastIdentifier);
9052  return 0;
9053}
9054
9055int iiArithAddCmd(
9056  const char *szName,
9057  short nAlias,
9058  short nTokval,
9059  short nToktype,
9060  short nPos
9061  )
9062{
9063  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9064  //       nTokval, nToktype, nPos);
9065  if(nPos>=0)
9066  {
9067    // no checks: we rely on a correct generated code in iparith.inc
9068    assume(nPos < sArithBase.nCmdAllocated);
9069    assume(szName!=NULL);
9070    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9071    sArithBase.sCmds[nPos].alias   = nAlias;
9072    sArithBase.sCmds[nPos].tokval  = nTokval;
9073    sArithBase.sCmds[nPos].toktype = nToktype;
9074    sArithBase.nCmdUsed++;
9075    //if(nTokval>0) sArithBase.nLastIdentifier++;
9076  }
9077  else
9078  {
9079    if(szName==NULL) return -1;
9080    int nIndex = iiArithFindCmd(szName);
9081    if(nIndex>=0)
9082    {
9083      Print("'%s' already exists at %d\n", szName, nIndex);
9084      return -1;
9085    }
9086
9087    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9088    {
9089      /* needs to create new slots */
9090      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9091      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9092      if(sArithBase.sCmds==NULL) return -1;
9093      sArithBase.nCmdAllocated++;
9094    }
9095    /* still free slots available */
9096    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9097    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9098    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9099    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9100    sArithBase.nCmdUsed++;
9101
9102    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9103          (&_gentable_sort_cmds));
9104    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9105        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9106    {
9107      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9108    }
9109    //Print("L=%d\n", sArithBase.nLastIdentifier);
9110  }
9111  return 0;
9112}
9113
9114static BOOLEAN check_valid(const int p, const int op)
9115{
9116  #ifdef HAVE_PLURAL
9117  if (rIsPluralRing(currRing))
9118  {
9119    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
9120    {
9121      WerrorS("not implemented for non-commutative rings");
9122      return TRUE;
9123    }
9124    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
9125    {
9126      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
9127      return FALSE;
9128    }
9129    /* else, ALLOW_PLURAL */
9130  }
9131  #endif
9132  #ifdef HAVE_RINGS
9133  if (rField_is_Ring(currRing))
9134  {
9135    if ((p & RING_MASK)==0 /*NO_RING*/)
9136    {
9137      WerrorS("not implemented for rings with rings as coeffients");
9138      return TRUE;
9139    }
9140    /* else ALLOW_RING */
9141    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9142    &&(!rField_is_Domain(currRing)))
9143    {
9144      WerrorS("domain required as coeffients");
9145      return TRUE;
9146    }
9147    /* else ALLOW_ZERODIVISOR */
9148    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9149    {
9150      WarnS("considering the image in Q[...]");
9151    }
9152  }
9153  #endif
9154  return FALSE;
9155}
Note: See TracBrowser for help on using the repository browser.