source: git/Singular/iparith.cc @ f3a5b8

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