source: git/Singular/iparith.cc @ d18df5

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