source: git/Singular/iparith.cc @ cd4f24

jengelh-datetimespielwiese
Last change on this file since cd4f24 was cd4f24, checked in by Yue Ren <ren@…>, 10 years ago
fix: -Wunused-but-set-variable warnings
  • Property mode set to 100644
File size: 218.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8
9#include <stdlib.h>
10#include <string.h>
11#include <ctype.h>
12#include <stdio.h>
13#include <time.h>
14#include <unistd.h>
15
16#include "config.h"
17#include <coeffs/bigintmat.h>
18#include <kernel/mod2.h>
19#include <Singular/tok.h>
20#include <misc/options.h>
21#include <Singular/ipid.h>
22#include <misc/intvec.h>
23#include <omalloc/omalloc.h>
24#include <kernel/polys.h>
25#include <kernel/febase.h>
26#include <Singular/sdb.h>
27#include <kernel/ideals.h>
28#include <polys/prCopy.h>
29#include <polys/matpol.h>
30#include <kernel/kstd1.h>
31#include <kernel/timer.h>
32
33#include <kernel/preimage.h>
34
35#include <Singular/subexpr.h>
36#include <Singular/lists.h>
37#include <kernel/modulop.h>
38#ifdef HAVE_RINGS
39#include <coeffs/rmodulon.h>
40#include <coeffs/rmodulo2m.h>
41#include <coeffs/rintegers.h>
42#endif
43#include <coeffs/numbers.h>
44#include <kernel/stairc.h>
45#include <polys/monomials/maps.h>
46#include <Singular/maps_ip.h>
47#include <kernel/syz.h>
48#include <polys/weight.h>
49#include <Singular/ipconv.h>
50#include <Singular/ipprint.h>
51#include <Singular/attrib.h>
52#include <Singular/links/silink.h>
53#include <polys/sparsmat.h>
54#include <kernel/units.h>
55#include <Singular/janet.h>
56#include <kernel/GMPrat.h>
57#include <kernel/tgb.h>
58#include <kernel/walkProc.h>
59#include <polys/mod_raw.h>
60#include <Singular/MinorInterface.h>
61#include <kernel/linearAlgebra.h>
62#include <Singular/misc_ip.h>
63#include <Singular/linearAlgebra_ip.h>
64#ifdef HAVE_FACTORY
65#  include <factory/factory.h>
66#  include <polys/clapsing.h>
67#  include <kernel/kstdfac.h>
68#  include <kernel/fglm.h>
69#  include <Singular/fglm.h>
70#endif /* HAVE_FACTORY */
71#include <Singular/interpolation.h>
72
73#include <Singular/blackbox.h>
74#include <Singular/newstruct.h>
75#include <Singular/ipshell.h>
76//#include <kernel/mpr_inout.h>
77
78#include <kernel/timer.h>
79
80#include <polys/coeffrings.h>
81
82lists rDecompose(const ring r);
83ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
84
85
86// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
87
88#ifdef HAVE_PLURAL
89  #include <kernel/ratgring.h>
90  #include <kernel/nc.h>
91  #include <polys/nc/nc.h>
92  #include <polys/nc/sca.h>
93  #define ALLOW_PLURAL     1
94  #define NO_PLURAL        0
95  #define COMM_PLURAL      2
96  #define  PLURAL_MASK 3
97#else /* HAVE_PLURAL */
98  #define ALLOW_PLURAL     0
99  #define NO_PLURAL        0
100  #define COMM_PLURAL      0
101  #define  PLURAL_MASK     0
102#endif /* HAVE_PLURAL */
103
104#ifdef HAVE_RINGS
105  #define RING_MASK        4
106  #define ZERODIVISOR_MASK 8
107#else
108  #define RING_MASK        0
109  #define ZERODIVISOR_MASK 0
110#endif
111#define ALLOW_RING       4
112#define NO_RING          0
113#define NO_ZERODIVISOR   8
114#define ALLOW_ZERODIVISOR  0
115
116static BOOLEAN check_valid(const int p, const int op);
117
118/*=============== types =====================*/
119struct sValCmdTab
120{
121  short cmd;
122  short start;
123};
124
125typedef sValCmdTab jjValCmdTab[];
126
127struct _scmdnames
128{
129  char *name;
130  short alias;
131  short tokval;
132  short toktype;
133};
134typedef struct _scmdnames cmdnames;
135
136
137typedef char * (*Proc1)(char *);
138struct sValCmd1
139{
140  proc1 p;
141  short cmd;
142  short res;
143  short arg;
144  short valid_for;
145};
146
147typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
148struct sValCmd2
149{
150  proc2 p;
151  short cmd;
152  short res;
153  short arg1;
154  short arg2;
155  short valid_for;
156};
157
158typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
159struct sValCmd3
160{
161  proc3 p;
162  short cmd;
163  short res;
164  short arg1;
165  short arg2;
166  short arg3;
167  short valid_for;
168};
169struct sValCmdM
170{
171  proc1 p;
172  short cmd;
173  short res;
174  short number_of_args; /* -1: any, -2: any >0, .. */
175  short valid_for;
176};
177
178typedef struct
179{
180  cmdnames *sCmds;             /**< array of existing commands */
181  struct sValCmd1 *psValCmd1;
182  struct sValCmd2 *psValCmd2;
183  struct sValCmd3 *psValCmd3;
184  struct sValCmdM *psValCmdM;
185  int nCmdUsed;      /**< number of commands used */
186  int nCmdAllocated; /**< number of commands-slots allocated */
187  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
188} SArithBase;
189
190/*---------------------------------------------------------------------*
191 * File scope Variables (Variables share by several functions in
192 *                       the same file )
193 *
194 *---------------------------------------------------------------------*/
195static SArithBase sArithBase;  /**< Base entry for arithmetic */
196
197/*---------------------------------------------------------------------*
198 * Extern Functions declarations
199 *
200 *---------------------------------------------------------------------*/
201static int _gentable_sort_cmds(const void *a, const void *b);
202extern int iiArithRemoveCmd(char *szName);
203extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
204                         short nToktype, short nPos=-1);
205
206/*============= proc =======================*/
207static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
208static Subexpr jjMakeSub(leftv e);
209
210/*============= vars ======================*/
211extern int cmdtok;
212extern BOOLEAN expected_parms;
213
214#define ii_div_by_0 "div. by 0"
215
216int iiOp; /* the current operation*/
217
218/*=================== simple helpers =================*/
219poly pHeadProc(poly p)
220{
221  return pHead(p);
222}
223
224int iiTokType(int op)
225{
226  for (int i=0;i<sArithBase.nCmdUsed;i++)
227  {
228    if (sArithBase.sCmds[i].tokval==op)
229      return sArithBase.sCmds[i].toktype;
230  }
231  return 0;
232}
233
234/*=================== operations with 2 args.: static proc =================*/
235/* must be ordered: first operations for chars (infix ops),
236 * then alphabetically */
237
238static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
239{
240  bigintmat* aa= (bigintmat *)u->Data();
241  int bb = (int)(long)(v->Data());
242  if (errorreported) return TRUE;
243  bigintmat *cc=NULL;
244  switch (iiOp)
245  {
246    case '+': cc=bimAdd(aa,bb); break;
247    case '-': cc=bimSub(aa,bb); break;
248    case '*': cc=bimMult(aa,bb); break;
249  }
250  res->data=(char *)cc;
251  return cc==NULL;
252}
253static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
254{
255  return jjOP_BIM_I(res, v, u);
256}
257static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
258{
259  bigintmat* aa= (bigintmat *)u->Data();
260  number bb = (number)(v->Data());
261  if (errorreported) return TRUE;
262  bigintmat *cc=NULL;
263  switch (iiOp)
264  {
265    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
266  }
267  res->data=(char *)cc;
268  return cc==NULL;
269}
270static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
271{
272  return jjOP_BIM_BI(res, v, u);
273}
274static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
275{
276  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
277  int bb = (int)(long)(v->Data());
278  if (errorreported) return TRUE;
279  switch (iiOp)
280  {
281    case '+': (*aa) += bb; break;
282    case '-': (*aa) -= bb; break;
283    case '*': (*aa) *= bb; break;
284    case '/':
285    case INTDIV_CMD: (*aa) /= bb; break;
286    case '%': (*aa) %= bb; break;
287  }
288  res->data=(char *)aa;
289  return FALSE;
290}
291static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
292{
293  return jjOP_IV_I(res,v,u);
294}
295static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
296{
297  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
298  int bb = (int)(long)(v->Data());
299  int i=si_min(aa->rows(),aa->cols());
300  switch (iiOp)
301  {
302    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
303              break;
304    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
305              break;
306  }
307  res->data=(char *)aa;
308  return FALSE;
309}
310static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
311{
312  return jjOP_IM_I(res,v,u);
313}
314static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
315{
316  int l=(int)(long)v->Data();
317  if (l>0)
318  {
319    int d=(int)(long)u->Data();
320    intvec *vv=new intvec(l);
321    int i;
322    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
323    res->data=(char *)vv;
324  }
325  return (l<=0);
326}
327static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
328{
329  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
330  return FALSE;
331}
332static void jjEQUAL_REST(leftv res,leftv u,leftv v);
333static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
334{
335  intvec*    a = (intvec * )(u->Data());
336  intvec*    b = (intvec * )(v->Data());
337  int r=a->compare(b);
338  switch  (iiOp)
339  {
340    case '<':
341      res->data  = (char *) (r<0);
342      break;
343    case '>':
344      res->data  = (char *) (r>0);
345      break;
346    case LE:
347      res->data  = (char *) (r<=0);
348      break;
349    case GE:
350      res->data  = (char *) (r>=0);
351      break;
352    case EQUAL_EQUAL:
353    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
354      res->data  = (char *) (r==0);
355      break;
356  }
357  jjEQUAL_REST(res,u,v);
358  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
359  return FALSE;
360}
361static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
362{
363  bigintmat*    a = (bigintmat * )(u->Data());
364  bigintmat*    b = (bigintmat * )(v->Data());
365  int r=a->compare(b);
366  switch  (iiOp)
367  {
368    case '<':
369      res->data  = (char *) (r<0);
370      break;
371    case '>':
372      res->data  = (char *) (r>0);
373      break;
374    case LE:
375      res->data  = (char *) (r<=0);
376      break;
377    case GE:
378      res->data  = (char *) (r>=0);
379      break;
380    case EQUAL_EQUAL:
381    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
382      res->data  = (char *) (r==0);
383      break;
384  }
385  jjEQUAL_REST(res,u,v);
386  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
387  return FALSE;
388}
389static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
390{
391  intvec* a = (intvec * )(u->Data());
392  int     b = (int)(long)(v->Data());
393  int r=a->compare(b);
394  switch  (iiOp)
395  {
396    case '<':
397      res->data  = (char *) (r<0);
398      break;
399    case '>':
400      res->data  = (char *) (r>0);
401      break;
402    case LE:
403      res->data  = (char *) (r<=0);
404      break;
405    case GE:
406      res->data  = (char *) (r>=0);
407      break;
408    case EQUAL_EQUAL:
409    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
410      res->data  = (char *) (r==0);
411      break;
412  }
413  jjEQUAL_REST(res,u,v);
414  return FALSE;
415}
416static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
417{
418  poly p=(poly)u->Data();
419  poly q=(poly)v->Data();
420  int r=pCmp(p,q);
421  if (r==0)
422  {
423    number h=nSub(pGetCoeff(p),pGetCoeff(q));
424    /* compare lead coeffs */
425    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
426    nDelete(&h);
427  }
428  else if (p==NULL)
429  {
430    if (q==NULL)
431    {
432      /* compare 0, 0 */
433      r=0;
434    }
435    else if(pIsConstant(q))
436    {
437      /* compare 0, const */
438      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
439    }
440  }
441  else if (q==NULL)
442  {
443    if (pIsConstant(p))
444    {
445      /* compare const, 0 */
446      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
447    }
448  }
449  switch  (iiOp)
450  {
451    case '<':
452      res->data  = (char *) (r < 0);
453      break;
454    case '>':
455      res->data  = (char *) (r > 0);
456      break;
457    case LE:
458      res->data  = (char *) (r <= 0);
459      break;
460    case GE:
461      res->data  = (char *) (r >= 0);
462      break;
463    //case EQUAL_EQUAL:
464    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
465    //  res->data  = (char *) (r == 0);
466    //  break;
467  }
468  jjEQUAL_REST(res,u,v);
469  return FALSE;
470}
471static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
472{
473  char*    a = (char * )(u->Data());
474  char*    b = (char * )(v->Data());
475  int result = strcmp(a,b);
476  switch  (iiOp)
477  {
478    case '<':
479      res->data  = (char *) (result  < 0);
480      break;
481    case '>':
482      res->data  = (char *) (result  > 0);
483      break;
484    case LE:
485      res->data  = (char *) (result  <= 0);
486      break;
487    case GE:
488      res->data  = (char *) (result  >= 0);
489      break;
490    case EQUAL_EQUAL:
491    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
492      res->data  = (char *) (result  == 0);
493      break;
494  }
495  jjEQUAL_REST(res,u,v);
496  return FALSE;
497}
498static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
499{
500  if (u->Next()!=NULL)
501  {
502    u=u->next;
503    res->next = (leftv)omAllocBin(sleftv_bin);
504    return iiExprArith2(res->next,u,iiOp,v);
505  }
506  else if (v->Next()!=NULL)
507  {
508    v=v->next;
509    res->next = (leftv)omAllocBin(sleftv_bin);
510    return iiExprArith2(res->next,u,iiOp,v);
511  }
512  return FALSE;
513}
514static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
515{
516  int b=(int)(long)u->Data();
517  int e=(int)(long)v->Data();
518  int rc = 1;
519  BOOLEAN overflow=FALSE;
520  if (e >= 0)
521  {
522    if (b==0)
523    {
524      rc=(e==0);
525    }
526    else if ((e==0)||(b==1))
527    {
528      rc= 1;
529    }
530    else if (b== -1)
531    {
532      if (e&1) rc= -1;
533      else     rc= 1;
534    }
535    else
536    {
537      int oldrc;
538      while ((e--)!=0)
539      {
540        oldrc=rc;
541        rc *= b;
542        if (!overflow)
543        {
544          if(rc/b!=oldrc) overflow=TRUE;
545        }
546      }
547      if (overflow)
548        WarnS("int overflow(^), result may be wrong");
549    }
550    res->data = (char *)((long)rc);
551    if (u!=NULL) return jjOP_REST(res,u,v);
552    return FALSE;
553  }
554  else
555  {
556    WerrorS("exponent must be non-negative");
557    return TRUE;
558  }
559}
560static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
561{
562  int e=(int)(long)v->Data();
563  number n=(number)u->Data();
564  if (e>=0)
565  {
566    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
567  }
568  else
569  {
570    WerrorS("exponent must be non-negative");
571    return TRUE;
572  }
573  if (u!=NULL) return jjOP_REST(res,u,v);
574  return FALSE;
575}
576static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
577{
578  int e=(int)(long)v->Data();
579  number n=(number)u->Data();
580  int d=0;
581  if (e<0)
582  {
583    n=nInvers(n);
584    e=-e;
585    d=1;
586  }
587  nPower(n,e,(number*)&res->data);
588  if (d) nDelete(&n);
589  if (u!=NULL) return jjOP_REST(res,u,v);
590  return FALSE;
591}
592static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
593{
594  int v_i=(int)(long)v->Data();
595  if (v_i<0)
596  {
597    WerrorS("exponent must be non-negative");
598    return TRUE;
599  }
600  poly u_p=(poly)u->CopyD(POLY_CMD);
601  if ((u_p!=NULL)
602  && ((v_i!=0) &&
603      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i)))
604  {
605    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
606                                    pTotaldegree(u_p),v_i,currRing->bitmask);
607    pDelete(&u_p);
608    return TRUE;
609  }
610  res->data = (char *)pPower(u_p,v_i);
611  if (u!=NULL) return jjOP_REST(res,u,v);
612  return errorreported; /* pPower may set errorreported via Werror */
613}
614static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
615{
616  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
617  if (u!=NULL) return jjOP_REST(res,u,v);
618  return FALSE;
619}
620static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
621{
622  u=u->next;
623  v=v->next;
624  if (u==NULL)
625  {
626    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
627    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
628    {
629      do
630      {
631        if (res->next==NULL)
632          res->next = (leftv)omAlloc0Bin(sleftv_bin);
633        leftv tmp_v=v->next;
634        v->next=NULL;
635        BOOLEAN b=iiExprArith1(res->next,v,'-');
636        v->next=tmp_v;
637        if (b)
638          return TRUE;
639        v=tmp_v;
640        res=res->next;
641      } while (v!=NULL);
642      return FALSE;
643    }
644    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
645    {
646      res->next = (leftv)omAlloc0Bin(sleftv_bin);
647      res=res->next;
648      res->data = v->CopyD();
649      res->rtyp = v->Typ();
650      v=v->next;
651      if (v==NULL) return FALSE;
652    }
653  }
654  if (v!=NULL)                     /* u<>NULL, v<>NULL */
655  {
656    do
657    {
658      res->next = (leftv)omAlloc0Bin(sleftv_bin);
659      leftv tmp_u=u->next; u->next=NULL;
660      leftv tmp_v=v->next; v->next=NULL;
661      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
662      u->next=tmp_u;
663      v->next=tmp_v;
664      if (b)
665        return TRUE;
666      u=tmp_u;
667      v=tmp_v;
668      res=res->next;
669    } while ((u!=NULL) && (v!=NULL));
670    return FALSE;
671  }
672  loop                             /* u<>NULL, v==NULL */
673  {
674    res->next = (leftv)omAlloc0Bin(sleftv_bin);
675    res=res->next;
676    res->data = u->CopyD();
677    res->rtyp = u->Typ();
678    u=u->next;
679    if (u==NULL) return FALSE;
680  }
681}
682static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
683{
684  idhdl packhdl;
685  switch(u->Typ())
686  {
687      case 0:
688      {
689        int name_err=0;
690        if(isupper(u->name[0]))
691        {
692          const char *c=u->name+1;
693          while((*c!='\0')&&(islower(*c))) c++;
694          if (*c!='\0')
695            name_err=1;
696          else
697          {
698            Print("%s of type 'ANY'. Trying load.\n", u->name);
699            if(iiTryLoadLib(u, u->name))
700            {
701              Werror("'%s' no such package", u->name);
702              return TRUE;
703            }
704            syMake(u,u->name,NULL);
705          }
706        }
707        else name_err=1;
708        if(name_err)
709        { Werror("'%s' is an invalid package name",u->name);return TRUE;}
710        // and now, after the loading: use next case !!! no break !!!
711      }
712      case PACKAGE_CMD:
713        packhdl = (idhdl)u->data;
714        if((!IDPACKAGE(packhdl)->loaded)
715        && (IDPACKAGE(packhdl)->language > LANG_TOP))
716        {
717          Werror("'%s' not loaded", u->name);
718          return TRUE;
719        }
720        if(v->rtyp == IDHDL)
721        {
722          v->name = omStrDup(v->name);
723        }
724        v->req_packhdl=IDPACKAGE(packhdl);
725        syMake(v, v->name, packhdl);
726        memcpy(res, v, sizeof(sleftv));
727        memset(v, 0, sizeof(sleftv));
728        break;
729      case DEF_CMD:
730        break;
731      default:
732        WerrorS("<package>::<id> expected");
733        return TRUE;
734  }
735  return FALSE;
736}
737static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
738{
739  unsigned int a=(unsigned int)(unsigned long)u->Data();
740  unsigned int b=(unsigned int)(unsigned long)v->Data();
741  unsigned int c=a+b;
742  res->data = (char *)((long)c);
743  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
744  {
745    WarnS("int overflow(+), result may be wrong");
746  }
747  return jjPLUSMINUS_Gen(res,u,v);
748}
749static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
750{
751  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
752  return jjPLUSMINUS_Gen(res,u,v);
753}
754static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
755{
756  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
757  return jjPLUSMINUS_Gen(res,u,v);
758}
759static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
760{
761  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
762  return jjPLUSMINUS_Gen(res,u,v);
763}
764static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
765{
766  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
767  if (res->data==NULL)
768  {
769     WerrorS("intmat size not compatible");
770     return TRUE;
771  }
772  return jjPLUSMINUS_Gen(res,u,v);
773}
774static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
775{
776  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
777  if (res->data==NULL)
778  {
779    WerrorS("bigintmat size not compatible");
780    return TRUE;
781  }
782  return jjPLUSMINUS_Gen(res,u,v);
783}
784static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
785{
786  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
787  res->data = (char *)(mp_Add(A , B, currRing));
788  if (res->data==NULL)
789  {
790     Werror("matrix size not compatible(%dx%d, %dx%d)",
791             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
792     return TRUE;
793  }
794  return jjPLUSMINUS_Gen(res,u,v);
795}
796static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
797{
798  matrix m=(matrix)u->Data();
799  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
800  if (iiOp=='+')
801    res->data = (char *)mp_Add(m , p,currRing);
802  else
803    res->data = (char *)mp_Sub(m , p,currRing);
804  idDelete((ideal *)&p);
805  return jjPLUSMINUS_Gen(res,u,v);
806}
807static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
808{
809  return jjPLUS_MA_P(res,v,u);
810}
811static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
812{
813  char*    a = (char * )(u->Data());
814  char*    b = (char * )(v->Data());
815  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
816  strcpy(r,a);
817  strcat(r,b);
818  res->data=r;
819  return jjPLUSMINUS_Gen(res,u,v);
820}
821static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
822{
823  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
824  return jjPLUSMINUS_Gen(res,u,v);
825}
826static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
827{
828  void *ap=u->Data(); void *bp=v->Data();
829  int aa=(int)(long)ap;
830  int bb=(int)(long)bp;
831  int cc=aa-bb;
832  unsigned int a=(unsigned int)(unsigned long)ap;
833  unsigned int b=(unsigned int)(unsigned long)bp;
834  unsigned int c=a-b;
835  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
836  {
837    WarnS("int overflow(-), result may be wrong");
838  }
839  res->data = (char *)((long)cc);
840  return jjPLUSMINUS_Gen(res,u,v);
841}
842static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
843{
844  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
845  return jjPLUSMINUS_Gen(res,u,v);
846}
847static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
848{
849  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
850  return jjPLUSMINUS_Gen(res,u,v);
851}
852static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
853{
854  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
855  return jjPLUSMINUS_Gen(res,u,v);
856}
857static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
858{
859  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
860  if (res->data==NULL)
861  {
862     WerrorS("intmat size not compatible");
863     return TRUE;
864  }
865  return jjPLUSMINUS_Gen(res,u,v);
866}
867static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
868{
869  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
870  if (res->data==NULL)
871  {
872    WerrorS("bigintmat size not compatible");
873    return TRUE;
874  }
875  return jjPLUSMINUS_Gen(res,u,v);
876}
877static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
878{
879  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
880  res->data = (char *)(mp_Sub(A , B, currRing));
881  if (res->data==NULL)
882  {
883     Werror("matrix size not compatible(%dx%d, %dx%d)",
884             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
885     return TRUE;
886  }
887  return jjPLUSMINUS_Gen(res,u,v);
888  return FALSE;
889}
890static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
891{
892  int a=(int)(long)u->Data();
893  int b=(int)(long)v->Data();
894  int64 c=(int64)a * (int64)b;
895  if ((c>INT_MAX)||(c<INT_MIN))
896    WarnS("int overflow(*), result may be wrong");
897  res->data = (char *)((long)((int)c));
898  if ((u->Next()!=NULL) || (v->Next()!=NULL))
899    return jjOP_REST(res,u,v);
900  return FALSE;
901}
902static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
903{
904  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
905  if ((v->next!=NULL) || (u->next!=NULL))
906    return jjOP_REST(res,u,v);
907  return FALSE;
908}
909static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
910{
911  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
912  number n=(number)res->data;
913  nNormalize(n);
914  res->data=(char *)n;
915  if ((v->next!=NULL) || (u->next!=NULL))
916    return jjOP_REST(res,u,v);
917  return FALSE;
918}
919static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
920{
921  poly a;
922  poly b;
923  if (v->next==NULL)
924  {
925    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
926    if (u->next==NULL)
927    {
928      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
929      if ((a!=NULL) && (b!=NULL)
930      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask)-(long)pTotaldegree(b)))
931      {
932        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
933          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
934        pDelete(&a);
935        pDelete(&b);
936        return TRUE;
937      }
938      res->data = (char *)(pMult( a, b));
939      pNormalize((poly)res->data);
940      return FALSE;
941    }
942    // u->next exists: copy v
943    b=pCopy((poly)v->Data());
944    if ((a!=NULL) && (b!=NULL)
945    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
946    {
947      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
948          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
949      pDelete(&a);
950      pDelete(&b);
951      return TRUE;
952    }
953    res->data = (char *)(pMult( a, b));
954    pNormalize((poly)res->data);
955    return jjOP_REST(res,u,v);
956  }
957  // v->next exists: copy u
958  a=pCopy((poly)u->Data());
959  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
960  if ((a!=NULL) && (b!=NULL)
961  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
962  {
963    pDelete(&a);
964    pDelete(&b);
965    WerrorS("OVERFLOW");
966    return TRUE;
967  }
968  res->data = (char *)(pMult( a, b));
969  pNormalize((poly)res->data);
970  return jjOP_REST(res,u,v);
971}
972static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
973{
974  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
975  id_Normalize((ideal)res->data,currRing);
976  if ((v->next!=NULL) || (u->next!=NULL))
977    return jjOP_REST(res,u,v);
978  return FALSE;
979}
980static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
981{
982  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
983  if (res->data==NULL)
984  {
985     WerrorS("intmat size not compatible");
986     return TRUE;
987  }
988  if ((v->next!=NULL) || (u->next!=NULL))
989    return jjOP_REST(res,u,v);
990  return FALSE;
991}
992static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
993{
994  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
995  if (res->data==NULL)
996  {
997    WerrorS("bigintmat size not compatible");
998    return TRUE;
999  }
1000  if ((v->next!=NULL) || (u->next!=NULL))
1001    return jjOP_REST(res,u,v);
1002  return FALSE;
1003}
1004static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
1005{
1006  number n=n_Init_bigint((number)v->Data(),coeffs_BIGINT,currRing->cf);
1007  poly p=pNSet(n);
1008  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1009  res->data = (char *)I;
1010  return FALSE;
1011}
1012static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
1013{
1014  return jjTIMES_MA_BI1(res,v,u);
1015}
1016static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
1017{
1018  poly p=(poly)v->CopyD(POLY_CMD);
1019  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1020  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1021  if (r>0) I->rank=r;
1022  id_Normalize(I,currRing);
1023  res->data = (char *)I;
1024  return FALSE;
1025}
1026static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1027{
1028  poly p=(poly)u->CopyD(POLY_CMD);
1029  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1030  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1031  if (r>0) I->rank=r;
1032  id_Normalize(I,currRing);
1033  res->data = (char *)I;
1034  return FALSE;
1035}
1036static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1037{
1038  number n=(number)v->CopyD(NUMBER_CMD);
1039  poly p=pNSet(n);
1040  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1041  id_Normalize((ideal)res->data,currRing);
1042  return FALSE;
1043}
1044static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1045{
1046  return jjTIMES_MA_N1(res,v,u);
1047}
1048static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1049{
1050  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1051  id_Normalize((ideal)res->data,currRing);
1052  return FALSE;
1053}
1054static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1055{
1056  return jjTIMES_MA_I1(res,v,u);
1057}
1058static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1059{
1060  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1061  res->data = (char *)mp_Mult(A,B,currRing);
1062  if (res->data==NULL)
1063  {
1064     Werror("matrix size not compatible(%dx%d, %dx%d)",
1065             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1066     return TRUE;
1067  }
1068  id_Normalize((ideal)res->data,currRing);
1069  if ((v->next!=NULL) || (u->next!=NULL))
1070    return jjOP_REST(res,u,v);
1071  return FALSE;
1072}
1073static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1074{
1075  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1076  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1077  n_Delete(&h,coeffs_BIGINT);
1078  return FALSE;
1079}
1080static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1081{
1082  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1083  return FALSE;
1084}
1085static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1086{
1087  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1088                       || nEqual((number)u->Data(),(number)v->Data()));
1089  return FALSE;
1090}
1091static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1092{
1093  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1094  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1095  n_Delete(&h,coeffs_BIGINT);
1096  return FALSE;
1097}
1098static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1099{
1100  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1101  return FALSE;
1102}
1103static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1104{
1105  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1106  return FALSE;
1107}
1108static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1109{
1110  return jjGE_BI(res,v,u);
1111}
1112static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1113{
1114  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1115  return FALSE;
1116}
1117static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1118{
1119  return jjGE_N(res,v,u);
1120}
1121static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1122{
1123  return jjGT_BI(res,v,u);
1124}
1125static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1126{
1127  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1128  return FALSE;
1129}
1130static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1131{
1132  return jjGT_N(res,v,u);
1133}
1134static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1135{
1136  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1137  int a= (int)(long)u->Data();
1138  int b= (int)(long)v->Data();
1139  if (b==0)
1140  {
1141    WerrorS(ii_div_by_0);
1142    return TRUE;
1143  }
1144  int c=a%b;
1145  int r=0;
1146  switch (iiOp)
1147  {
1148    case '%':
1149        r=c;            break;
1150    case '/':
1151    case INTDIV_CMD:
1152        r=((a-c) /b);   break;
1153  }
1154  res->data=(void *)((long)r);
1155  return FALSE;
1156}
1157static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1158{
1159  number q=(number)v->Data();
1160  if (n_IsZero(q,coeffs_BIGINT))
1161  {
1162    WerrorS(ii_div_by_0);
1163    return TRUE;
1164  }
1165  q = n_IntDiv((number)u->Data(),q,coeffs_BIGINT);
1166  n_Normalize(q,coeffs_BIGINT);
1167  res->data = (char *)q;
1168  return FALSE;
1169}
1170static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1171{
1172  number q=(number)v->Data();
1173  if (nIsZero(q))
1174  {
1175    WerrorS(ii_div_by_0);
1176    return TRUE;
1177  }
1178  q = nDiv((number)u->Data(),q);
1179  nNormalize(q);
1180  res->data = (char *)q;
1181  return FALSE;
1182}
1183static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1184{
1185  poly q=(poly)v->Data();
1186  if (q==NULL)
1187  {
1188    WerrorS(ii_div_by_0);
1189    return TRUE;
1190  }
1191  poly p=(poly)(u->Data());
1192  if (p==NULL)
1193  {
1194    res->data=NULL;
1195    return FALSE;
1196  }
1197  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1198  { /* This means that q != 0 consists of at least two terms.
1199       Moreover, currRing is over a field. */
1200#ifdef HAVE_FACTORY
1201    if(pGetComp(p)==0)
1202    {
1203      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1204                                         q /*(poly)(v->Data())*/ ,currRing));
1205    }
1206    else
1207    {
1208      int comps=pMaxComp(p);
1209      ideal I=idInit(comps,1);
1210      p=pCopy(p);
1211      poly h;
1212      int i;
1213      // conversion to a list of polys:
1214      while (p!=NULL)
1215      {
1216        i=pGetComp(p)-1;
1217        h=pNext(p);
1218        pNext(p)=NULL;
1219        pSetComp(p,0);
1220        I->m[i]=pAdd(I->m[i],p);
1221        p=h;
1222      }
1223      // division and conversion to vector:
1224      h=NULL;
1225      p=NULL;
1226      for(i=comps-1;i>=0;i--)
1227      {
1228        if (I->m[i]!=NULL)
1229        {
1230          h=singclap_pdivide(I->m[i],q,currRing);
1231          pSetCompP(h,i+1);
1232          p=pAdd(p,h);
1233        }
1234      }
1235      idDelete(&I);
1236      res->data=(void *)p;
1237    }
1238#else /* HAVE_FACTORY */
1239    WerrorS("division only by a monomial");
1240    return TRUE;
1241#endif /* HAVE_FACTORY */
1242  }
1243  else
1244  { /* This means that q != 0 consists of just one term,
1245       or that currRing is over a coefficient ring. */
1246#ifdef HAVE_RINGS
1247    if (!rField_is_Domain(currRing))
1248    {
1249      WerrorS("division only defined over coefficient domains");
1250      return TRUE;
1251    }
1252    if (pNext(q)!=NULL)
1253    {
1254      WerrorS("division over a coefficient domain only implemented for terms");
1255      return TRUE;
1256    }
1257#endif
1258    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1259  }
1260  pNormalize((poly)res->data);
1261  return FALSE;
1262}
1263static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1264{
1265  poly q=(poly)v->Data();
1266  if (q==NULL)
1267  {
1268    WerrorS(ii_div_by_0);
1269    return TRUE;
1270  }
1271  matrix m=(matrix)(u->Data());
1272  int r=m->rows();
1273  int c=m->cols();
1274  matrix mm=mpNew(r,c);
1275  int i,j;
1276  for(i=r;i>0;i--)
1277  {
1278    for(j=c;j>0;j--)
1279    {
1280      if (pNext(q)!=NULL)
1281      {
1282      #ifdef HAVE_FACTORY
1283        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1284                                           q /*(poly)(v->Data())*/, currRing );
1285#else /* HAVE_FACTORY */
1286        WerrorS("division only by a monomial");
1287        return TRUE;
1288#endif /* HAVE_FACTORY */
1289      }
1290      else
1291        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1292    }
1293  }
1294  id_Normalize((ideal)mm,currRing);
1295  res->data=(char *)mm;
1296  return FALSE;
1297}
1298static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1299{
1300  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1301  jjEQUAL_REST(res,u,v);
1302  return FALSE;
1303}
1304static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1305{
1306  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1307  jjEQUAL_REST(res,u,v);
1308  return FALSE;
1309}
1310static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1311{
1312  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1313  jjEQUAL_REST(res,u,v);
1314  return FALSE;
1315}
1316static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1317{
1318  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1319  jjEQUAL_REST(res,u,v);
1320  return FALSE;
1321}
1322static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1323{
1324  poly p=(poly)u->Data();
1325  poly q=(poly)v->Data();
1326  res->data = (char *) ((long)pEqualPolys(p,q));
1327  jjEQUAL_REST(res,u,v);
1328  return FALSE;
1329}
1330static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1331{
1332  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1333  {
1334    int save_iiOp=iiOp;
1335    if (iiOp==NOTEQUAL)
1336      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1337    else
1338      iiExprArith2(res,u->next,iiOp,v->next);
1339    iiOp=save_iiOp;
1340  }
1341  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1342}
1343static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1344{
1345  res->data = (char *)((long)u->Data() && (long)v->Data());
1346  return FALSE;
1347}
1348static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1349{
1350  res->data = (char *)((long)u->Data() || (long)v->Data());
1351  return FALSE;
1352}
1353static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1354{
1355  res->rtyp=u->rtyp; u->rtyp=0;
1356  res->data=u->data; u->data=NULL;
1357  res->name=u->name; u->name=NULL;
1358  res->e=u->e;       u->e=NULL;
1359  if (res->e==NULL) res->e=jjMakeSub(v);
1360  else
1361  {
1362    Subexpr sh=res->e;
1363    while (sh->next != NULL) sh=sh->next;
1364    sh->next=jjMakeSub(v);
1365  }
1366  return FALSE;
1367}
1368static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1369{
1370  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1371  {
1372    WerrorS("indexed object must have a name");
1373    return TRUE;
1374  }
1375  intvec * iv=(intvec *)v->Data();
1376  leftv p=NULL;
1377  int i;
1378  sleftv t;
1379  memset(&t,0,sizeof(t));
1380  t.rtyp=INT_CMD;
1381  for (i=0;i<iv->length(); i++)
1382  {
1383    t.data=(char *)((long)(*iv)[i]);
1384    if (p==NULL)
1385    {
1386      p=res;
1387    }
1388    else
1389    {
1390      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1391      p=p->next;
1392    }
1393    p->rtyp=IDHDL;
1394    p->data=u->data;
1395    p->name=u->name;
1396    p->flag=u->flag;
1397    p->e=jjMakeSub(&t);
1398  }
1399  u->rtyp=0;
1400  u->data=NULL;
1401  u->name=NULL;
1402  return FALSE;
1403}
1404static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1405{
1406  poly p=(poly)u->Data();
1407  int i=(int)(long)v->Data();
1408  int j=0;
1409  while (p!=NULL)
1410  {
1411    j++;
1412    if (j==i)
1413    {
1414      res->data=(char *)pHead(p);
1415      return FALSE;
1416    }
1417    pIter(p);
1418  }
1419  return FALSE;
1420}
1421static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1422{
1423  poly p=(poly)u->Data();
1424  poly r=NULL;
1425  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1426  int i;
1427  int sum=0;
1428  for(i=iv->length()-1;i>=0;i--)
1429    sum+=(*iv)[i];
1430  int j=0;
1431  while ((p!=NULL) && (sum>0))
1432  {
1433    j++;
1434    for(i=iv->length()-1;i>=0;i--)
1435    {
1436      if (j==(*iv)[i])
1437      {
1438        r=pAdd(r,pHead(p));
1439        sum-=j;
1440        (*iv)[i]=0;
1441        break;
1442      }
1443    }
1444    pIter(p);
1445  }
1446  delete iv;
1447  res->data=(char *)r;
1448  return FALSE;
1449}
1450static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1451{
1452  poly p=(poly)u->CopyD(VECTOR_CMD);
1453  poly r=p; // pointer to the beginning of component i
1454  poly o=NULL;
1455  unsigned i=(unsigned)(long)v->Data();
1456  while (p!=NULL)
1457  {
1458    if (pGetComp(p)!=i)
1459    {
1460      if (r==p) r=pNext(p);
1461      if (o!=NULL)
1462      {
1463        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1464        p=pNext(o);
1465      }
1466      else
1467        pLmDelete(&p);
1468    }
1469    else
1470    {
1471      pSetComp(p, 0);
1472      p_SetmComp(p, currRing);
1473      o=p;
1474      p=pNext(o);
1475    }
1476  }
1477  res->data=(char *)r;
1478  return FALSE;
1479}
1480static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1481{
1482  poly p=(poly)u->CopyD(VECTOR_CMD);
1483  if (p!=NULL)
1484  {
1485    poly r=pOne();
1486    poly hp=r;
1487    intvec *iv=(intvec *)v->Data();
1488    int i;
1489    loop
1490    {
1491      for(i=0;i<iv->length();i++)
1492      {
1493        if (((int)pGetComp(p))==(*iv)[i])
1494        {
1495          poly h;
1496          pSplit(p,&h);
1497          pNext(hp)=p;
1498          p=h;
1499          pIter(hp);
1500          break;
1501        }
1502      }
1503      if (p==NULL) break;
1504      if (i==iv->length())
1505      {
1506        pLmDelete(&p);
1507        if (p==NULL) break;
1508      }
1509    }
1510    pLmDelete(&r);
1511    res->data=(char *)r;
1512  }
1513  return FALSE;
1514}
1515static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1516static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1517{
1518  if(u->name==NULL) return TRUE;
1519  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1520  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1521  omFree((ADDRESS)u->name);
1522  u->name=NULL;
1523  char *n=omStrDup(nn);
1524  omFree((ADDRESS)nn);
1525  syMake(res,n);
1526  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1527  return FALSE;
1528}
1529static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1530{
1531  intvec * iv=(intvec *)v->Data();
1532  leftv p=NULL;
1533  int i;
1534  long slen = strlen(u->name) + 14;
1535  char *n = (char*) omAlloc(slen);
1536
1537  for (i=0;i<iv->length(); i++)
1538  {
1539    if (p==NULL)
1540    {
1541      p=res;
1542    }
1543    else
1544    {
1545      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1546      p=p->next;
1547    }
1548    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1549    syMake(p,omStrDup(n));
1550  }
1551  omFree((ADDRESS)u->name);
1552  u->name = NULL;
1553  omFreeSize(n, slen);
1554  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1555  return FALSE;
1556}
1557static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1558{
1559  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1560  memset(tmp,0,sizeof(sleftv));
1561  BOOLEAN b;
1562  if (v->Typ()==INTVEC_CMD)
1563    b=jjKLAMMER_IV(tmp,u,v);
1564  else
1565    b=jjKLAMMER(tmp,u,v);
1566  if (b)
1567  {
1568    omFreeBin(tmp,sleftv_bin);
1569    return TRUE;
1570  }
1571  leftv h=res;
1572  while (h->next!=NULL) h=h->next;
1573  h->next=tmp;
1574  return FALSE;
1575}
1576BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1577{
1578  void *d;
1579  Subexpr e;
1580  int typ;
1581  BOOLEAN t=FALSE;
1582  idhdl tmp_proc=NULL;
1583  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1584  {
1585    tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1586    tmp_proc->id="_auto";
1587    tmp_proc->typ=PROC_CMD;
1588    tmp_proc->data.pinf=(procinfo *)u->Data();
1589    tmp_proc->ref=1;
1590    d=u->data; u->data=(void *)tmp_proc;
1591    e=u->e; u->e=NULL;
1592    t=TRUE;
1593    typ=u->rtyp; u->rtyp=IDHDL;
1594  }
1595  BOOLEAN sl;
1596  if (u->req_packhdl==currPack)
1597    sl = iiMake_proc((idhdl)u->data,NULL,v);
1598  else
1599    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1600  if (t)
1601  {
1602    u->rtyp=typ;
1603    u->data=d;
1604    u->e=e;
1605    omFreeSize(tmp_proc,sizeof(idrec));
1606  }
1607  if (sl) return TRUE;
1608  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1609  iiRETURNEXPR.Init();
1610  return FALSE;
1611}
1612static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1613{
1614  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1615  leftv sl=NULL;
1616  if ((v->e==NULL)&&(v->name!=NULL))
1617  {
1618    map m=(map)u->Data();
1619    sl=iiMap(m,v->name);
1620  }
1621  else
1622  {
1623    Werror("%s(<name>) expected",u->Name());
1624  }
1625  if (sl==NULL) return TRUE;
1626  memcpy(res,sl,sizeof(sleftv));
1627  omFreeBin((ADDRESS)sl, sleftv_bin);
1628  return FALSE;
1629}
1630#ifdef HAVE_FACTORY
1631static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1632{
1633  intvec *c=(intvec*)u->Data();
1634  intvec* p=(intvec*)v->Data();
1635  int rl=p->length();
1636  number *x=(number *)omAlloc(rl*sizeof(number));
1637  number *q=(number *)omAlloc(rl*sizeof(number));
1638  int i;
1639  for(i=rl-1;i>=0;i--)
1640  {
1641    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1642    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1643  }
1644  number n=n_ChineseRemainderSym(x,q,rl,FALSE,coeffs_BIGINT);
1645  for(i=rl-1;i>=0;i--)
1646  {
1647    n_Delete(&(q[i]),coeffs_BIGINT);
1648    n_Delete(&(x[i]),coeffs_BIGINT);
1649  }
1650  omFree(x); omFree(q);
1651  res->data=(char *)n;
1652  return FALSE;
1653}
1654#endif
1655#if 0
1656static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1657{
1658  lists c=(lists)u->CopyD(); // list of poly
1659  intvec* p=(intvec*)v->Data();
1660  int rl=p->length();
1661  poly r=NULL,h, result=NULL;
1662  number *x=(number *)omAlloc(rl*sizeof(number));
1663  number *q=(number *)omAlloc(rl*sizeof(number));
1664  int i;
1665  for(i=rl-1;i>=0;i--)
1666  {
1667    q[i]=nlInit((*p)[i]);
1668  }
1669  loop
1670  {
1671    for(i=rl-1;i>=0;i--)
1672    {
1673      if (c->m[i].Typ()!=POLY_CMD)
1674      {
1675        Werror("poly expected at pos %d",i+1);
1676        for(i=rl-1;i>=0;i--)
1677        {
1678          nlDelete(&(q[i]),currRing);
1679        }
1680        omFree(x); omFree(q); // delete c
1681        return TRUE;
1682      }
1683      h=((poly)c->m[i].Data());
1684      if (r==NULL) r=h;
1685      else if (pLmCmp(r,h)==-1) r=h;
1686    }
1687    if (r==NULL) break;
1688    for(i=rl-1;i>=0;i--)
1689    {
1690      h=((poly)c->m[i].Data());
1691      if (pLmCmp(r,h)==0)
1692      {
1693        x[i]=pGetCoeff(h);
1694        h=pLmFreeAndNext(h);
1695        c->m[i].data=(char*)h;
1696      }
1697      else
1698        x[i]=nlInit(0);
1699    }
1700    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1701    for(i=rl-1;i>=0;i--)
1702    {
1703      nlDelete(&(x[i]),currRing);
1704    }
1705    h=pHead(r);
1706    pSetCoeff(h,n);
1707    result=pAdd(result,h);
1708  }
1709  for(i=rl-1;i>=0;i--)
1710  {
1711    nlDelete(&(q[i]),currRing);
1712  }
1713  omFree(x); omFree(q);
1714  res->data=(char *)result;
1715  return FALSE;
1716}
1717#endif
1718#ifdef HAVE_FACTORY
1719static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1720{
1721  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
1722  lists pl=NULL;
1723  intvec *p=NULL;
1724  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1725  else                    p=(intvec*)v->Data();
1726  int rl=c->nr+1;
1727  ideal result;
1728  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1729  number *xx=NULL;
1730  int i;
1731  int return_type=c->m[0].Typ();
1732  if ((return_type!=IDEAL_CMD)
1733  && (return_type!=MODUL_CMD)
1734  && (return_type!=MATRIX_CMD))
1735  {
1736    if((return_type!=BIGINT_CMD)&&(return_type!=INT_CMD))
1737    {
1738      WerrorS("ideal/module/matrix expected");
1739      omFree(x); // delete c
1740      return TRUE;
1741    }
1742    else
1743      return_type=BIGINT_CMD;
1744  }
1745  if (return_type!=BIGINT_CMD)
1746  {
1747    for(i=rl-1;i>=0;i--)
1748    {
1749      if (c->m[i].Typ()!=return_type)
1750      {
1751        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1752        omFree(x); // delete c
1753        return TRUE;
1754      }
1755      x[i]=((ideal)c->m[i].Data());
1756    }
1757  }
1758  else
1759  {
1760    xx=(number *)omAlloc(rl*sizeof(number));
1761    for(i=rl-1;i>=0;i--)
1762    {
1763      if (c->m[i].Typ()==INT_CMD)
1764      {
1765        xx[i]=n_Init(((int)(long)c->m[i].Data()),coeffs_BIGINT);
1766      }
1767      else if (c->m[i].Typ()==BIGINT_CMD)
1768      {
1769        xx[i]=(number)c->m[i].Data();
1770      }
1771      else
1772      {
1773        Werror("bigint expected at pos %d",i+1);
1774        omFree(x); // delete c
1775        omFree(xx); // delete c
1776        return TRUE;
1777      }
1778    }
1779  }
1780  number *q=(number *)omAlloc(rl*sizeof(number));
1781  if (p!=NULL)
1782  {
1783    for(i=rl-1;i>=0;i--)
1784    {
1785      q[i]=n_Init((*p)[i], currRing->cf);
1786    }
1787  }
1788  else
1789  {
1790    for(i=rl-1;i>=0;i--)
1791    {
1792      if (pl->m[i].Typ()==INT_CMD)
1793      {
1794        if (return_type==BIGINT_CMD)
1795          q[i]=n_Init((int)(long)pl->m[i].Data(),coeffs_BIGINT);
1796        else
1797          q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1798      }
1799      else if (pl->m[i].Typ()==BIGINT_CMD)
1800      {
1801        if (return_type==BIGINT_CMD)
1802          q[i]=n_Copy((number)(pl->m[i].Data()),coeffs_BIGINT);
1803        else
1804          q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1805      }
1806      else
1807      {
1808        Werror("bigint expected at pos %d",i+1);
1809        if (return_type==BIGINT_CMD)
1810        for(i++;i<rl;i++)
1811        {
1812          n_Delete(&(q[i]),coeffs_BIGINT);
1813        }
1814        else
1815        for(i++;i<rl;i++)
1816        {
1817          n_Delete(&(q[i]),currRing);
1818        }
1819
1820        omFree(x); // delete c
1821        omFree(q); // delete pl
1822        if (xx!=NULL) omFree(xx); // delete c
1823        return TRUE;
1824      }
1825    }
1826  }
1827  if (return_type==BIGINT_CMD)
1828  {
1829    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,coeffs_BIGINT);
1830    res->data=(char *)n;
1831  }
1832  else
1833  {
1834    result=id_ChineseRemainder(x,q,rl,currRing);
1835    // deletes also x
1836    res->data=(char *)result;
1837  }
1838  if (return_type==BIGINT_CMD)
1839  for(i=rl-1;i>=0;i--)
1840  {
1841    n_Delete(&(q[i]),coeffs_BIGINT);
1842  }
1843  else
1844  for(i=rl-1;i>=0;i--)
1845  {
1846    n_Delete(&(q[i]),currRing);
1847  }
1848  omFree(q);
1849  res->rtyp=return_type;
1850  return FALSE;
1851}
1852#endif
1853static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1854{
1855  poly p=(poly)v->Data();
1856  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1857  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1858  return FALSE;
1859}
1860static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1861{
1862  int i=pVar((poly)v->Data());
1863  if (i==0)
1864  {
1865    WerrorS("ringvar expected");
1866    return TRUE;
1867  }
1868  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1869  return FALSE;
1870}
1871static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1872{
1873  poly p = pInit();
1874  int i;
1875  for (i=1; i<=currRing->N; i++)
1876  {
1877    pSetExp(p, i, 1);
1878  }
1879  pSetm(p);
1880  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1881                                    (ideal)(v->Data()), p);
1882  pDelete(&p);
1883  return FALSE;
1884}
1885static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1886{
1887  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1888  return FALSE;
1889}
1890static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1891{
1892  short *iv=iv2array((intvec *)v->Data(),currRing);
1893  ideal I=(ideal)u->Data();
1894  int d=-1;
1895  int i;
1896  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)p_DegW(I->m[i],iv,currRing));
1897  omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1898  res->data = (char *)((long)d);
1899  return FALSE;
1900}
1901static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1902{
1903  poly p=(poly)u->Data();
1904  if (p!=NULL)
1905  {
1906    short *iv=iv2array((intvec *)v->Data(),currRing);
1907    const long d = p_DegW(p,iv,currRing);
1908    omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1909    res->data = (char *)(d);
1910  }
1911  else
1912    res->data=(char *)(long)(-1);
1913  return FALSE;
1914}
1915static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1916{
1917  int i=pVar((poly)v->Data());
1918  if (i==0)
1919  {
1920    WerrorS("ringvar expected");
1921    return TRUE;
1922  }
1923  res->data=(char *)pDiff((poly)(u->Data()),i);
1924  return FALSE;
1925}
1926static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1927{
1928  int i=pVar((poly)v->Data());
1929  if (i==0)
1930  {
1931    WerrorS("ringvar expected");
1932    return TRUE;
1933  }
1934  res->data=(char *)idDiff((matrix)(u->Data()),i);
1935  return FALSE;
1936}
1937static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1938{
1939  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1940  return FALSE;
1941}
1942static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1943{
1944  assumeStdFlag(v);
1945#ifdef HAVE_RINGS
1946  if (rField_is_Ring(currRing))
1947  {
1948    //ring origR = currRing;
1949    //ring tempR = rCopy(origR);
1950    //coeffs new_cf=nInitChar(n_Q,NULL);
1951    //nKillChar(tempR->cf);
1952    //tempR->cf=new_cf;
1953    //rComplete(tempR);
1954    ideal vid = (ideal)v->Data();
1955    int i = idPosConstant(vid);
1956    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1957    { /* ideal v contains unit; dim = -1 */
1958      res->data = (char *)-1;
1959      return FALSE;
1960    }
1961    //rChangeCurrRing(tempR);
1962    //ideal vv = idrCopyR(vid, origR, currRing);
1963    ideal vv = id_Copy(vid, currRing);
1964    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1965    ideal ww = id_Copy((ideal)w->Data(), currRing);
1966    /* drop degree zero generator from vv (if any) */
1967    if (i != -1) pDelete(&vv->m[i]);
1968    long d = (long)scDimInt(vv, ww);
1969    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
1970    res->data = (char *)d;
1971    idDelete(&vv); idDelete(&ww);
1972    //rChangeCurrRing(origR);
1973    //rDelete(tempR);
1974    return FALSE;
1975  }
1976#endif
1977  if(currQuotient==NULL)
1978    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1979  else
1980  {
1981    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1982    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1983    idDelete(&q);
1984  }
1985  return FALSE;
1986}
1987static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1988{
1989  ideal vi=(ideal)v->Data();
1990  int vl= IDELEMS(vi);
1991  ideal ui=(ideal)u->Data();
1992  int ul= IDELEMS(ui);
1993  ideal R; matrix U;
1994  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1995  if (m==NULL) return TRUE;
1996  // now make sure that all matices have the corect size:
1997  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
1998  int i;
1999  if (MATCOLS(U) != ul)
2000  {
2001    int mul=si_min(ul,MATCOLS(U));
2002    matrix UU=mpNew(ul,ul);
2003    int j;
2004    for(i=mul;i>0;i--)
2005    {
2006      for(j=mul;j>0;j--)
2007      {
2008        MATELEM(UU,i,j)=MATELEM(U,i,j);
2009        MATELEM(U,i,j)=NULL;
2010      }
2011    }
2012    idDelete((ideal *)&U);
2013    U=UU;
2014  }
2015  // make sure that U is a diagonal matrix of units
2016  for(i=ul;i>0;i--)
2017  {
2018    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
2019  }
2020  lists L=(lists)omAllocBin(slists_bin);
2021  L->Init(3);
2022  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
2023  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
2024  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
2025  res->data=(char *)L;
2026  return FALSE;
2027}
2028static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
2029{
2030  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
2031  //setFlag(res,FLAG_STD);
2032  return FALSE;
2033}
2034static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
2035{
2036  poly p=pOne();
2037  intvec *iv=(intvec*)v->Data();
2038  for(int i=iv->length()-1; i>=0; i--)
2039  {
2040    pSetExp(p,(*iv)[i],1);
2041  }
2042  pSetm(p);
2043  res->data=(char *)idElimination((ideal)u->Data(),p);
2044  pLmDelete(&p);
2045  //setFlag(res,FLAG_STD);
2046  return FALSE;
2047}
2048static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
2049{
2050  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
2051  return iiExport(v,0,(idhdl)u->data);
2052}
2053static BOOLEAN jjERROR(leftv, leftv u)
2054{
2055  WerrorS((char *)u->Data());
2056  extern int inerror;
2057  inerror=3;
2058  return TRUE;
2059}
2060static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
2061{
2062  number uu=(number)u->Data();number vv=(number)v->Data();
2063  lists L=(lists)omAllocBin(slists_bin);
2064  number a,b;
2065  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
2066  L->Init(3);
2067  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
2068  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
2069  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
2070  res->rtyp=LIST_CMD;
2071  res->data=(char *)L;
2072  return FALSE;
2073}
2074static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
2075{
2076  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2077  int p0=ABS(uu),p1=ABS(vv);
2078  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2079
2080  while ( p1!=0 )
2081  {
2082    q=p0 / p1;
2083    r=p0 % p1;
2084    p0 = p1; p1 = r;
2085    r = g0 - g1 * q;
2086    g0 = g1; g1 = r;
2087    r = f0 - f1 * q;
2088    f0 = f1; f1 = r;
2089  }
2090  int a = f0;
2091  int b = g0;
2092  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2093  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2094  lists L=(lists)omAllocBin(slists_bin);
2095  L->Init(3);
2096  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2097  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2098  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2099  res->rtyp=LIST_CMD;
2100  res->data=(char *)L;
2101  return FALSE;
2102}
2103#ifdef HAVE_FACTORY
2104static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2105{
2106  poly r,pa,pb;
2107  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2108  if (ret) return TRUE;
2109  lists L=(lists)omAllocBin(slists_bin);
2110  L->Init(3);
2111  res->data=(char *)L;
2112  L->m[0].data=(void *)r;
2113  L->m[0].rtyp=POLY_CMD;
2114  L->m[1].data=(void *)pa;
2115  L->m[1].rtyp=POLY_CMD;
2116  L->m[2].data=(void *)pb;
2117  L->m[2].rtyp=POLY_CMD;
2118  return FALSE;
2119}
2120extern int singclap_factorize_retry;
2121static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2122{
2123  intvec *v=NULL;
2124  int sw=(int)(long)dummy->Data();
2125  int fac_sw=sw;
2126  if ((sw<0)||(sw>2)) fac_sw=1;
2127  singclap_factorize_retry=0;
2128  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2129  if (f==NULL)
2130    return TRUE;
2131  switch(sw)
2132  {
2133    case 0:
2134    case 2:
2135    {
2136      lists l=(lists)omAllocBin(slists_bin);
2137      l->Init(2);
2138      l->m[0].rtyp=IDEAL_CMD;
2139      l->m[0].data=(void *)f;
2140      l->m[1].rtyp=INTVEC_CMD;
2141      l->m[1].data=(void *)v;
2142      res->data=(void *)l;
2143      res->rtyp=LIST_CMD;
2144      return FALSE;
2145    }
2146    case 1:
2147      res->data=(void *)f;
2148      return FALSE;
2149    case 3:
2150      {
2151        poly p=f->m[0];
2152        int i=IDELEMS(f);
2153        f->m[0]=NULL;
2154        while(i>1)
2155        {
2156          i--;
2157          p=pMult(p,f->m[i]);
2158          f->m[i]=NULL;
2159        }
2160        res->data=(void *)p;
2161        res->rtyp=POLY_CMD;
2162      }
2163      return FALSE;
2164  }
2165  WerrorS("invalid switch");
2166  return TRUE;
2167}
2168static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2169{
2170  ideal_list p,h;
2171  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2172  p=h;
2173  int l=0;
2174  while (p!=NULL) { p=p->next;l++; }
2175  lists L=(lists)omAllocBin(slists_bin);
2176  L->Init(l);
2177  l=0;
2178  while(h!=NULL)
2179  {
2180    L->m[l].data=(char *)h->d;
2181    L->m[l].rtyp=IDEAL_CMD;
2182    p=h->next;
2183    omFreeSize(h,sizeof(*h));
2184    h=p;
2185    l++;
2186  }
2187  res->data=(void *)L;
2188  return FALSE;
2189}
2190#endif /* HAVE_FACTORY */
2191static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2192{
2193  if (rField_is_Q(currRing))
2194  {
2195    number uu=(number)u->Data();
2196    number vv=(number)v->Data();
2197    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2198    return FALSE;
2199  }
2200  else return TRUE;
2201}
2202static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2203{
2204  ideal uu=(ideal)u->Data();
2205  number vv=(number)v->Data();
2206  res->data=(void*)id_Farey(uu,vv,currRing);
2207  res->rtyp=u->Typ();
2208  return FALSE;
2209}
2210static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2211{
2212  ring r=(ring)u->Data();
2213  idhdl w;
2214  int op=iiOp;
2215  nMapFunc nMap;
2216
2217  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2218  {
2219    int *perm=NULL;
2220    int *par_perm=NULL;
2221    int par_perm_size=0;
2222    BOOLEAN bo;
2223    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2224    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2225    {
2226      // Allow imap/fetch to be make an exception only for:
2227      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2228            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2229             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2230           ||
2231           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2232            (rField_is_Zp(currRing, r->cf->ch) ||
2233             rField_is_Zp_a(currRing, r->cf->ch))) )
2234      {
2235        par_perm_size=rPar(r);
2236      }
2237      else
2238      {
2239        goto err_fetch;
2240      }
2241    }
2242    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2243    {
2244      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2245      if (par_perm_size!=0)
2246        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2247      op=IMAP_CMD;
2248      if (iiOp==IMAP_CMD)
2249      {
2250        int r_par=0;
2251        char ** r_par_names=NULL;
2252        if (r->cf->extRing!=NULL)
2253        {
2254          r_par=r->cf->extRing->N;
2255          r_par_names=r->cf->extRing->names;
2256        }
2257        int c_par=0;
2258        char ** c_par_names=NULL;
2259        if (currRing->cf->extRing!=NULL)
2260        {
2261          c_par=currRing->cf->extRing->N;
2262          c_par_names=currRing->cf->extRing->names;
2263        }
2264        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2265                   currRing->names,currRing->N,c_par_names, c_par,
2266                   perm,par_perm, currRing->cf->type);
2267      }
2268      else
2269      {
2270        int i;
2271        if (par_perm_size!=0)
2272          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2273        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2274      }
2275    }
2276    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2277    {
2278      int i;
2279      for(i=0;i<si_min(r->N,currRing->N);i++)
2280      {
2281        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2282      }
2283      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2284      {
2285        Print("// par nr %d: %s -> %s\n",
2286              i,rParameter(r)[i],rParameter(currRing)[i]);
2287      }
2288    }
2289    sleftv tmpW;
2290    memset(&tmpW,0,sizeof(sleftv));
2291    tmpW.rtyp=IDTYP(w);
2292    tmpW.data=IDDATA(w);
2293    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2294                         perm,par_perm,par_perm_size,nMap)))
2295    {
2296      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2297    }
2298    if (perm!=NULL)
2299      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2300    if (par_perm!=NULL)
2301      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2302    return bo;
2303  }
2304  else
2305  {
2306    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2307  }
2308  return TRUE;
2309err_fetch:
2310  Werror("no identity map from %s",u->Fullname());
2311  return TRUE;
2312}
2313static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2314{
2315  /*4
2316  * look for the substring what in the string where
2317  * return the position of the first char of what in where
2318  * or 0
2319  */
2320  char *where=(char *)u->Data();
2321  char *what=(char *)v->Data();
2322  char *found = strstr(where,what);
2323  if (found != NULL)
2324  {
2325    res->data=(char *)((found-where)+1);
2326  }
2327  /*else res->data=NULL;*/
2328  return FALSE;
2329}
2330static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2331{
2332  res->data=(char *)fractalWalkProc(u,v);
2333  setFlag( res, FLAG_STD );
2334  return FALSE;
2335}
2336static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2337{
2338  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2339  int p0=ABS(uu),p1=ABS(vv);
2340  int r;
2341  while ( p1!=0 )
2342  {
2343    r=p0 % p1;
2344    p0 = p1; p1 = r;
2345  }
2346  res->rtyp=INT_CMD;
2347  res->data=(char *)(long)p0;
2348  return FALSE;
2349}
2350static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2351{
2352#ifdef HAVE_FACTORY
2353  number n1 = (number) u->CopyD();
2354  number n2 = (number) v->CopyD();
2355  CanonicalForm C1, C2;
2356  C1 = coeffs_BIGINT->convSingNFactoryN (n1,TRUE,coeffs_BIGINT);
2357  C2 = coeffs_BIGINT->convSingNFactoryN (n2,TRUE,coeffs_BIGINT);
2358  CanonicalForm G = gcd (C1,C2);
2359  number g = coeffs_BIGINT->convFactoryNSingN (G,coeffs_BIGINT);
2360  res->data = g;
2361  return FALSE;
2362#else
2363  number a=(number) u->Data();
2364  number b=(number) v->Data();
2365  if (n_IsZero(a,coeffs_BIGINT))
2366  {
2367    if (n_IsZero(b,coeffs_BIGINT)) res->data=(char *)n_Init(1,coeffs_BIGINT);
2368    else                           res->data=(char *)n_Copy(b,coeffs_BIGINT);
2369  }
2370  else
2371  {
2372    if (n_IsZero(b,coeffs_BIGINT))  res->data=(char *)n_Copy(a,coeffs_BIGINT);
2373    else res->data=(char *)n_Gcd(a, b, coeffs_BIGINT);
2374  }
2375  return FALSE;
2376#endif
2377}
2378static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2379{
2380  number a=(number) u->Data();
2381  number b=(number) v->Data();
2382  if (nIsZero(a))
2383  {
2384    if (nIsZero(b)) res->data=(char *)nInit(1);
2385    else            res->data=(char *)nCopy(b);
2386  }
2387  else
2388  {
2389    if (nIsZero(b))  res->data=(char *)nCopy(a);
2390    else res->data=(char *)nGcd(a, b, currRing);
2391  }
2392  return FALSE;
2393}
2394#ifdef HAVE_FACTORY
2395static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2396{
2397  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2398                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2399  return FALSE;
2400}
2401#endif /* HAVE_FACTORY */
2402static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2403{
2404#ifdef HAVE_RINGS
2405  if (rField_is_Ring_Z(currRing))
2406  {
2407    ring origR = currRing;
2408    ring tempR = rCopy(origR);
2409    coeffs new_cf=nInitChar(n_Q,NULL);
2410    nKillChar(tempR->cf);
2411    tempR->cf=new_cf;
2412    rComplete(tempR);
2413    ideal uid = (ideal)u->Data();
2414    rChangeCurrRing(tempR);
2415    ideal uu = idrCopyR(uid, origR, currRing);
2416    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2417    uuAsLeftv.rtyp = IDEAL_CMD;
2418    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2419    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2420    assumeStdFlag(&uuAsLeftv);
2421    Print("// NOTE: computation of Hilbert series etc. is being\n");
2422    Print("//       performed for generic fibre, that is, over Q\n");
2423    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2424    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2425    int returnWithTrue = 1;
2426    switch((int)(long)v->Data())
2427    {
2428      case 1:
2429        res->data=(void *)iv;
2430        returnWithTrue = 0;
2431      case 2:
2432        res->data=(void *)hSecondSeries(iv);
2433        delete iv;
2434        returnWithTrue = 0;
2435    }
2436    if (returnWithTrue)
2437    {
2438      WerrorS(feNotImplemented);
2439      delete iv;
2440    }
2441    idDelete(&uu);
2442    rChangeCurrRing(origR);
2443    rDelete(tempR);
2444    if (returnWithTrue) return TRUE; else return FALSE;
2445  }
2446#endif
2447  assumeStdFlag(u);
2448  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2449  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2450  switch((int)(long)v->Data())
2451  {
2452    case 1:
2453      res->data=(void *)iv;
2454      return FALSE;
2455    case 2:
2456      res->data=(void *)hSecondSeries(iv);
2457      delete iv;
2458      return FALSE;
2459  }
2460  WerrorS(feNotImplemented);
2461  delete iv;
2462  return TRUE;
2463}
2464static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2465{
2466  int i=pVar((poly)v->Data());
2467  if (i==0)
2468  {
2469    WerrorS("ringvar expected");
2470    return TRUE;
2471  }
2472  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2473  int d=pWTotaldegree(p);
2474  pLmDelete(p);
2475  if (d==1)
2476    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2477  else
2478    WerrorS("variable must have weight 1");
2479  return (d!=1);
2480}
2481static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2482{
2483  int i=pVar((poly)v->Data());
2484  if (i==0)
2485  {
2486    WerrorS("ringvar expected");
2487    return TRUE;
2488  }
2489  pFDegProc deg;
2490  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2491    deg=p_Totaldegree;
2492   else
2493    deg=currRing->pFDeg;
2494  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2495  int d=deg(p,currRing);
2496  pLmDelete(p);
2497  if (d==1)
2498    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2499  else
2500    WerrorS("variable must have weight 1");
2501  return (d!=1);
2502}
2503static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2504{
2505  intvec *w=new intvec(rVar(currRing));
2506  intvec *vw=(intvec*)u->Data();
2507  ideal v_id=(ideal)v->Data();
2508  pFDegProc save_FDeg=currRing->pFDeg;
2509  pLDegProc save_LDeg=currRing->pLDeg;
2510  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2511  currRing->pLexOrder=FALSE;
2512  kHomW=vw;
2513  kModW=w;
2514  pSetDegProcs(currRing,kHomModDeg);
2515  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2516  currRing->pLexOrder=save_pLexOrder;
2517  kHomW=NULL;
2518  kModW=NULL;
2519  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2520  if (w!=NULL) delete w;
2521  return FALSE;
2522}
2523static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2524{
2525  assumeStdFlag(u);
2526  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2527                    currQuotient);
2528  return FALSE;
2529}
2530static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2531{
2532  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2533  setFlag(res,FLAG_STD);
2534  return FALSE;
2535}
2536static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2537{
2538  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2539}
2540static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2541{
2542  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2543  return FALSE;
2544}
2545static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2546{
2547  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2548  return FALSE;
2549}
2550static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2551{
2552  assumeStdFlag(u);
2553  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2554  res->data = (char *)scKBase((int)(long)v->Data(),
2555                              (ideal)(u->Data()),currQuotient, w_u);
2556  if (w_u!=NULL)
2557  {
2558    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2559  }
2560  return FALSE;
2561}
2562static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2563static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2564{
2565  return jjPREIMAGE(res,u,v,NULL);
2566}
2567static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2568{
2569  return mpKoszul(res, u,v,NULL);
2570}
2571static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2572{
2573  sleftv h;
2574  memset(&h,0,sizeof(sleftv));
2575  h.rtyp=INT_CMD;
2576  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2577  return mpKoszul(res, u, &h, v);
2578}
2579static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2580{
2581  int ul= IDELEMS((ideal)u->Data());
2582  int vl= IDELEMS((ideal)v->Data());
2583  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2584                   hasFlag(u,FLAG_STD));
2585  if (m==NULL) return TRUE;
2586  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2587  return FALSE;
2588}
2589static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2590{
2591  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2592  idhdl h=(idhdl)v->data;
2593  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2594  res->data = (char *)idLiftStd((ideal)u->Data(),
2595                                &(h->data.umatrix),testHomog);
2596  setFlag(res,FLAG_STD); v->flag=0;
2597  return FALSE;
2598}
2599static BOOLEAN jjLOAD2(leftv /*res*/, leftv, leftv v)
2600{
2601  return jjLOAD((char*)v->Data(),TRUE);
2602}
2603static BOOLEAN jjLOAD_E(leftv /*res*/, leftv v, leftv u)
2604{
2605  char * s=(char *)u->Data();
2606  if(strcmp(s, "with")==0)
2607    return jjLOAD((char*)v->Data(), TRUE);
2608  WerrorS("invalid second argument");
2609  WerrorS("load(\"libname\" [,\"with\"]);");
2610  return TRUE;
2611}
2612static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2613{
2614  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2615  tHomog hom=testHomog;
2616  if (w_u!=NULL)
2617  {
2618    w_u=ivCopy(w_u);
2619    hom=isHomog;
2620  }
2621  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2622  if (w_v!=NULL)
2623  {
2624    w_v=ivCopy(w_v);
2625    hom=isHomog;
2626  }
2627  if ((w_u!=NULL) && (w_v==NULL))
2628    w_v=ivCopy(w_u);
2629  if ((w_v!=NULL) && (w_u==NULL))
2630    w_u=ivCopy(w_v);
2631  ideal u_id=(ideal)u->Data();
2632  ideal v_id=(ideal)v->Data();
2633  if (w_u!=NULL)
2634  {
2635     if ((*w_u).compare((w_v))!=0)
2636     {
2637       WarnS("incompatible weights");
2638       delete w_u; w_u=NULL;
2639       hom=testHomog;
2640     }
2641     else
2642     {
2643       if ((!idTestHomModule(u_id,currQuotient,w_v))
2644       || (!idTestHomModule(v_id,currQuotient,w_v)))
2645       {
2646         WarnS("wrong weights");
2647         delete w_u; w_u=NULL;
2648         hom=testHomog;
2649       }
2650     }
2651  }
2652  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2653  if (w_u!=NULL)
2654  {
2655    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2656  }
2657  delete w_v;
2658  return FALSE;
2659}
2660static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2661{
2662  number q=(number)v->Data();
2663  if (n_IsZero(q,coeffs_BIGINT))
2664  {
2665    WerrorS(ii_div_by_0);
2666    return TRUE;
2667  }
2668  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2669  return FALSE;
2670}
2671static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2672{
2673  number q=(number)v->Data();
2674  if (nIsZero(q))
2675  {
2676    WerrorS(ii_div_by_0);
2677    return TRUE;
2678  }
2679  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2680  return FALSE;
2681}
2682static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2683static BOOLEAN jjMONITOR1(leftv res, leftv v)
2684{
2685  return jjMONITOR2(res,v,NULL);
2686}
2687static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2688{
2689#if 0
2690  char *opt=(char *)v->Data();
2691  int mode=0;
2692  while(*opt!='\0')
2693  {
2694    if (*opt=='i') mode |= PROT_I;
2695    else if (*opt=='o') mode |= PROT_O;
2696    opt++;
2697  }
2698  monitor((char *)(u->Data()),mode);
2699#else
2700  si_link l=(si_link)u->Data();
2701  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2702  if(strcmp(l->m->type,"ASCII")!=0)
2703  {
2704    Werror("ASCII link required, not `%s`",l->m->type);
2705    slClose(l);
2706    return TRUE;
2707  }
2708  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2709  if ( l->name[0]!='\0') // "" is the stop condition
2710  {
2711    const char *opt;
2712    int mode=0;
2713    if (v==NULL) opt=(const char*)"i";
2714    else         opt=(const char *)v->Data();
2715    while(*opt!='\0')
2716    {
2717      if (*opt=='i') mode |= PROT_I;
2718      else if (*opt=='o') mode |= PROT_O;
2719      opt++;
2720    }
2721    monitor((FILE *)l->data,mode);
2722  }
2723  else
2724    monitor(NULL,0);
2725  return FALSE;
2726#endif
2727}
2728static BOOLEAN jjMONOM(leftv res, leftv v)
2729{
2730  intvec *iv=(intvec *)v->Data();
2731  poly p=pOne();
2732  int i,e;
2733  BOOLEAN err=FALSE;
2734  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2735  {
2736    e=(*iv)[i-1];
2737    if (e>=0) pSetExp(p,i,e);
2738    else err=TRUE;
2739  }
2740  if (iv->length()==(currRing->N+1))
2741  {
2742    res->rtyp=VECTOR_CMD;
2743    e=(*iv)[currRing->N];
2744    if (e>=0) pSetComp(p,e);
2745    else err=TRUE;
2746  }
2747  pSetm(p);
2748  res->data=(char*)p;
2749  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2750  return err;
2751}
2752static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2753{
2754  // u: the name of the new type
2755  // v: the elements
2756  newstruct_desc d=newstructFromString((const char *)v->Data());
2757  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2758  return d==NULL;
2759}
2760static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2761{
2762  idhdl h=(idhdl)u->data;
2763  int i=(int)(long)v->Data();
2764  int p=0;
2765  if ((0<i)
2766  && (rParameter(IDRING(h))!=NULL)
2767  && (i<=(p=rPar(IDRING(h)))))
2768    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2769  else
2770  {
2771    Werror("par number %d out of range 1..%d",i,p);
2772    return TRUE;
2773  }
2774  return FALSE;
2775}
2776#ifdef HAVE_PLURAL
2777static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2778{
2779  if( currRing->qideal != NULL )
2780  {
2781    WerrorS("basering must NOT be a qring!");
2782    return TRUE;
2783  }
2784
2785  if (iiOp==NCALGEBRA_CMD)
2786  {
2787    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2788  }
2789  else
2790  {
2791    ring r=rCopy(currRing);
2792    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2793    res->data=r;
2794    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2795    return result;
2796  }
2797}
2798static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2799{
2800  if( currRing->qideal != NULL )
2801  {
2802    WerrorS("basering must NOT be a qring!");
2803    return TRUE;
2804  }
2805
2806  if (iiOp==NCALGEBRA_CMD)
2807  {
2808    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2809  }
2810  else
2811  {
2812    ring r=rCopy(currRing);
2813    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2814    res->data=r;
2815    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2816    return result;
2817  }
2818}
2819static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2820{
2821  if( currRing->qideal != NULL )
2822  {
2823    WerrorS("basering must NOT be a qring!");
2824    return TRUE;
2825  }
2826
2827  if (iiOp==NCALGEBRA_CMD)
2828  {
2829    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2830  }
2831  else
2832  {
2833    ring r=rCopy(currRing);
2834    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2835    res->data=r;
2836    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2837    return result;
2838  }
2839}
2840static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2841{
2842  if( currRing->qideal != NULL )
2843  {
2844    WerrorS("basering must NOT be a qring!");
2845    return TRUE;
2846  }
2847
2848  if (iiOp==NCALGEBRA_CMD)
2849  {
2850    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2851  }
2852  else
2853  {
2854    ring r=rCopy(currRing);
2855    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2856    res->data=r;
2857    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2858    return result;
2859  }
2860}
2861static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2862{
2863  res->data=NULL;
2864
2865  if (rIsPluralRing(currRing))
2866  {
2867    const poly q = (poly)b->Data();
2868
2869    if( q != NULL )
2870    {
2871      if( (poly)a->Data() != NULL )
2872      {
2873        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2874        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2875      }
2876    }
2877  }
2878  return FALSE;
2879}
2880static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2881{
2882  /* number, poly, vector, ideal, module, matrix */
2883  ring  r = (ring)a->Data();
2884  if (r == currRing)
2885  {
2886    res->data = b->Data();
2887    res->rtyp = b->rtyp;
2888    return FALSE;
2889  }
2890  if (!rIsLikeOpposite(currRing, r))
2891  {
2892    Werror("%s is not an opposite ring to current ring",a->Fullname());
2893    return TRUE;
2894  }
2895  idhdl w;
2896  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2897  {
2898    int argtype = IDTYP(w);
2899    switch (argtype)
2900    {
2901    case NUMBER_CMD:
2902      {
2903        /* since basefields are equal, we can apply nCopy */
2904        res->data = nCopy((number)IDDATA(w));
2905        res->rtyp = argtype;
2906        break;
2907      }
2908    case POLY_CMD:
2909    case VECTOR_CMD:
2910      {
2911        poly    q = (poly)IDDATA(w);
2912        res->data = pOppose(r,q,currRing);
2913        res->rtyp = argtype;
2914        break;
2915      }
2916    case IDEAL_CMD:
2917    case MODUL_CMD:
2918      {
2919        ideal   Q = (ideal)IDDATA(w);
2920        res->data = idOppose(r,Q,currRing);
2921        res->rtyp = argtype;
2922        break;
2923      }
2924    case MATRIX_CMD:
2925      {
2926        ring save = currRing;
2927        rChangeCurrRing(r);
2928        matrix  m = (matrix)IDDATA(w);
2929        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2930        rChangeCurrRing(save);
2931        ideal   S = idOppose(r,Q,currRing);
2932        id_Delete(&Q, r);
2933        res->data = id_Module2Matrix(S,currRing);
2934        res->rtyp = argtype;
2935        break;
2936      }
2937    default:
2938      {
2939        WerrorS("unsupported type in oppose");
2940        return TRUE;
2941      }
2942    }
2943  }
2944  else
2945  {
2946    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2947    return TRUE;
2948  }
2949  return FALSE;
2950}
2951#endif /* HAVE_PLURAL */
2952
2953static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2954{
2955  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2956    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2957  id_DelMultiples((ideal)(res->data),currRing);
2958  return FALSE;
2959}
2960static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2961{
2962  int i=(int)(long)u->Data();
2963  int j=(int)(long)v->Data();
2964  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2965  return FALSE;
2966}
2967static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2968{
2969  matrix m =(matrix)u->Data();
2970  int isRowEchelon = (int)(long)v->Data();
2971  if (isRowEchelon != 1) isRowEchelon = 0;
2972  int rank = luRank(m, isRowEchelon);
2973  res->data =(char *)(long)rank;
2974  return FALSE;
2975}
2976static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2977{
2978  si_link l=(si_link)u->Data();
2979  leftv r=slRead(l,v);
2980  if (r==NULL)
2981  {
2982    const char *s;
2983    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2984    else                            s=sNoName;
2985    Werror("cannot read from `%s`",s);
2986    return TRUE;
2987  }
2988  memcpy(res,r,sizeof(sleftv));
2989  omFreeBin((ADDRESS)r, sleftv_bin);
2990  return FALSE;
2991}
2992static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2993{
2994  assumeStdFlag(v);
2995  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2996  return FALSE;
2997}
2998static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2999{
3000  assumeStdFlag(v);
3001  ideal ui=(ideal)u->Data();
3002  ideal vi=(ideal)v->Data();
3003  res->data = (char *)kNF(vi,currQuotient,ui);
3004  return FALSE;
3005}
3006#if 0
3007static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3008{
3009  int maxl=(int)(long)v->Data();
3010  if (maxl<0)
3011  {
3012    WerrorS("length for res must not be negative");
3013    return TRUE;
3014  }
3015  int l=0;
3016  //resolvente r;
3017  syStrategy r;
3018  intvec *weights=NULL;
3019  int wmaxl=maxl;
3020  ideal u_id=(ideal)u->Data();
3021
3022  maxl--;
3023  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3024  {
3025    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3026    if (currQuotient!=NULL)
3027    {
3028      Warn(
3029      "full resolution in a qring may be infinite, setting max length to %d",
3030      maxl+1);
3031    }
3032  }
3033  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3034  if (weights!=NULL)
3035  {
3036    if (!idTestHomModule(u_id,currQuotient,weights))
3037    {
3038      WarnS("wrong weights given:");weights->show();PrintLn();
3039      weights=NULL;
3040    }
3041  }
3042  intvec *ww=NULL;
3043  int add_row_shift=0;
3044  if (weights!=NULL)
3045  {
3046     ww=ivCopy(weights);
3047     add_row_shift = ww->min_in();
3048     (*ww) -= add_row_shift;
3049  }
3050  else
3051    idHomModule(u_id,currQuotient,&ww);
3052  weights=ww;
3053
3054  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3055  {
3056    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3057  }
3058  else if (iiOp==SRES_CMD)
3059  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3060    r=sySchreyer(u_id,maxl+1);
3061  else if (iiOp == LRES_CMD)
3062  {
3063    int dummy;
3064    if((currQuotient!=NULL)||
3065    (!idHomIdeal (u_id,NULL)))
3066    {
3067       WerrorS
3068       ("`lres` not implemented for inhomogeneous input or qring");
3069       return TRUE;
3070    }
3071    r=syLaScala3(u_id,&dummy);
3072  }
3073  else if (iiOp == KRES_CMD)
3074  {
3075    int dummy;
3076    if((currQuotient!=NULL)||
3077    (!idHomIdeal (u_id,NULL)))
3078    {
3079       WerrorS
3080       ("`kres` not implemented for inhomogeneous input or qring");
3081       return TRUE;
3082    }
3083    r=syKosz(u_id,&dummy);
3084  }
3085  else
3086  {
3087    int dummy;
3088    if((currQuotient!=NULL)||
3089    (!idHomIdeal (u_id,NULL)))
3090    {
3091       WerrorS
3092       ("`hres` not implemented for inhomogeneous input or qring");
3093       return TRUE;
3094    }
3095    r=syHilb(u_id,&dummy);
3096  }
3097  if (r==NULL) return TRUE;
3098  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3099  r->list_length=wmaxl;
3100  res->data=(void *)r;
3101  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3102  {
3103    intvec *w=ivCopy(r->weights[0]);
3104    if (weights!=NULL) (*w) += add_row_shift;
3105    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3106    w=NULL;
3107  }
3108  else
3109  {
3110//#if 0
3111// need to set weights for ALL components (sres)
3112    if (weights!=NULL)
3113    {
3114      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3115      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3116      (r->weights)[0] = ivCopy(weights);
3117    }
3118//#endif
3119  }
3120  if (ww!=NULL) { delete ww; ww=NULL; }
3121  return FALSE;
3122}
3123#else
3124static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3125{
3126  int maxl=(int)(long)v->Data();
3127  if (maxl<0)
3128  {
3129    WerrorS("length for res must not be negative");
3130    return TRUE;
3131  }
3132  syStrategy r;
3133  intvec *weights=NULL;
3134  int wmaxl=maxl;
3135  ideal u_id=(ideal)u->Data();
3136
3137  maxl--;
3138  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3139  {
3140    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3141    if (currQuotient!=NULL)
3142    {
3143      Warn(
3144      "full resolution in a qring may be infinite, setting max length to %d",
3145      maxl+1);
3146    }
3147  }
3148  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3149  if (weights!=NULL)
3150  {
3151    if (!idTestHomModule(u_id,currQuotient,weights))
3152    {
3153      WarnS("wrong weights given:");weights->show();PrintLn();
3154      weights=NULL;
3155    }
3156  }
3157  intvec *ww=NULL;
3158  int add_row_shift=0;
3159  if (weights!=NULL)
3160  {
3161     ww=ivCopy(weights);
3162     add_row_shift = ww->min_in();
3163     (*ww) -= add_row_shift;
3164  }
3165  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3166  {
3167    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3168  }
3169  else if (iiOp==SRES_CMD)
3170  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3171    r=sySchreyer(u_id,maxl+1);
3172  else if (iiOp == LRES_CMD)
3173  {
3174    int dummy;
3175    if((currQuotient!=NULL)||
3176    (!idHomIdeal (u_id,NULL)))
3177    {
3178       WerrorS
3179       ("`lres` not implemented for inhomogeneous input or qring");
3180       return TRUE;
3181    }
3182    if(currRing->N == 1)
3183      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3184    r=syLaScala3(u_id,&dummy);
3185  }
3186  else if (iiOp == KRES_CMD)
3187  {
3188    int dummy;
3189    if((currQuotient!=NULL)||
3190    (!idHomIdeal (u_id,NULL)))
3191    {
3192       WerrorS
3193       ("`kres` not implemented for inhomogeneous input or qring");
3194       return TRUE;
3195    }
3196    r=syKosz(u_id,&dummy);
3197  }
3198  else
3199  {
3200    int dummy;
3201    if((currQuotient!=NULL)||
3202    (!idHomIdeal (u_id,NULL)))
3203    {
3204       WerrorS
3205       ("`hres` not implemented for inhomogeneous input or qring");
3206       return TRUE;
3207    }
3208    ideal u_id_copy=idCopy(u_id);
3209    idSkipZeroes(u_id_copy);
3210    r=syHilb(u_id_copy,&dummy);
3211    idDelete(&u_id_copy);
3212  }
3213  if (r==NULL) return TRUE;
3214  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3215  r->list_length=wmaxl;
3216  res->data=(void *)r;
3217  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3218  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3219  {
3220    ww=ivCopy(r->weights[0]);
3221    if (weights!=NULL) (*ww) += add_row_shift;
3222    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3223  }
3224  else
3225  {
3226    if (weights!=NULL)
3227    {
3228      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3229    }
3230  }
3231
3232  // test the La Scala case' output
3233  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3234  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3235
3236  if(iiOp != HRES_CMD)
3237    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3238  else
3239    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3240
3241  return FALSE;
3242}
3243#endif
3244static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3245{
3246  number n1; int i;
3247
3248  if ((u->Typ() == BIGINT_CMD) ||
3249     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3250  {
3251    n1 = (number)u->CopyD();
3252  }
3253  else if (u->Typ() == INT_CMD)
3254  {
3255    i = (int)(long)u->Data();
3256    n1 = n_Init(i, coeffs_BIGINT);
3257  }
3258  else
3259  {
3260    return TRUE;
3261  }
3262
3263  i = (int)(long)v->Data();
3264
3265  lists l = primeFactorisation(n1, i);
3266  n_Delete(&n1, coeffs_BIGINT);
3267  res->data = (char*)l;
3268  return FALSE;
3269}
3270static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3271{
3272  ring r;
3273  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3274  res->data = (char *)r;
3275  return (i==-1);
3276}
3277#define SIMPL_LMDIV 32
3278#define SIMPL_LMEQ  16
3279#define SIMPL_MULT 8
3280#define SIMPL_EQU  4
3281#define SIMPL_NULL 2
3282#define SIMPL_NORM 1
3283static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3284{
3285  int sw = (int)(long)v->Data();
3286  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3287  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3288  if (sw & SIMPL_LMDIV)
3289  {
3290    id_DelDiv(id,currRing);
3291  }
3292  if (sw & SIMPL_LMEQ)
3293  {
3294    id_DelLmEquals(id,currRing);
3295  }
3296  if (sw & SIMPL_MULT)
3297  {
3298    id_DelMultiples(id,currRing);
3299  }
3300  else if(sw & SIMPL_EQU)
3301  {
3302    id_DelEquals(id,currRing);
3303  }
3304  if (sw & SIMPL_NULL)
3305  {
3306    idSkipZeroes(id);
3307  }
3308  if (sw & SIMPL_NORM)
3309  {
3310    id_Norm(id,currRing);
3311  }
3312  res->data = (char * )id;
3313  return FALSE;
3314}
3315#ifdef HAVE_FACTORY
3316extern int singclap_factorize_retry;
3317static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3318{
3319  intvec *v=NULL;
3320  int sw=(int)(long)dummy->Data();
3321  int fac_sw=sw;
3322  if (sw<0) fac_sw=1;
3323  singclap_factorize_retry=0;
3324  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3325  if (f==NULL)
3326    return TRUE;
3327  switch(sw)
3328  {
3329    case 0:
3330    case 2:
3331    {
3332      lists l=(lists)omAllocBin(slists_bin);
3333      l->Init(2);
3334      l->m[0].rtyp=IDEAL_CMD;
3335      l->m[0].data=(void *)f;
3336      l->m[1].rtyp=INTVEC_CMD;
3337      l->m[1].data=(void *)v;
3338      res->data=(void *)l;
3339      res->rtyp=LIST_CMD;
3340      return FALSE;
3341    }
3342    case 1:
3343      res->data=(void *)f;
3344      return FALSE;
3345    case 3:
3346      {
3347        poly p=f->m[0];
3348        int i=IDELEMS(f);
3349        f->m[0]=NULL;
3350        while(i>1)
3351        {
3352          i--;
3353          p=pMult(p,f->m[i]);
3354          f->m[i]=NULL;
3355        }
3356        res->data=(void *)p;
3357        res->rtyp=POLY_CMD;
3358      }
3359      return FALSE;
3360  }
3361  WerrorS("invalid switch");
3362  return FALSE;
3363}
3364#endif
3365static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3366{
3367  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3368  return FALSE;
3369}
3370static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3371{
3372  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3373  //return (res->data== (void*)(long)-2);
3374  return FALSE;
3375}
3376static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3377{
3378  int sw = (int)(long)v->Data();
3379  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3380  poly p = (poly)u->CopyD(POLY_CMD);
3381  if (sw & SIMPL_NORM)
3382  {
3383    pNorm(p);
3384  }
3385  res->data = (char * )p;
3386  return FALSE;
3387}
3388static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3389{
3390  ideal result;
3391  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3392  tHomog hom=testHomog;
3393  ideal u_id=(ideal)(u->Data());
3394  if (w!=NULL)
3395  {
3396    if (!idTestHomModule(u_id,currQuotient,w))
3397    {
3398      WarnS("wrong weights:");w->show();PrintLn();
3399      w=NULL;
3400    }
3401    else
3402    {
3403      w=ivCopy(w);
3404      hom=isHomog;
3405    }
3406  }
3407  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3408  idSkipZeroes(result);
3409  res->data = (char *)result;
3410  setFlag(res,FLAG_STD);
3411  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3412  return FALSE;
3413}
3414static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3415static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3416/* destroys i0, p0 */
3417/* result (with attributes) in res */
3418/* i0: SB*/
3419/* t0: type of p0*/
3420/* p0 new elements*/
3421/* a attributes of i0*/
3422{
3423  int tp;
3424  if (t0==IDEAL_CMD) tp=POLY_CMD;
3425  else               tp=VECTOR_CMD;
3426  for (int i=IDELEMS(p0)-1; i>=0; i--)
3427  {
3428    poly p=p0->m[i];
3429    p0->m[i]=NULL;
3430    if (p!=NULL)
3431    {
3432      sleftv u0,v0;
3433      memset(&u0,0,sizeof(sleftv));
3434      memset(&v0,0,sizeof(sleftv));
3435      v0.rtyp=tp;
3436      v0.data=(void*)p;
3437      u0.rtyp=t0;
3438      u0.data=i0;
3439      u0.attribute=a;
3440      setFlag(&u0,FLAG_STD);
3441      jjSTD_1(res,&u0,&v0);
3442      i0=(ideal)res->data;
3443      res->data=NULL;
3444      a=res->attribute;
3445      res->attribute=NULL;
3446      u0.CleanUp();
3447      v0.CleanUp();
3448      res->CleanUp();
3449    }
3450  }
3451  idDelete(&p0);
3452  res->attribute=a;
3453  res->data=(void *)i0;
3454  res->rtyp=t0;
3455}
3456static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3457{
3458  ideal result;
3459  assumeStdFlag(u);
3460  ideal i1=(ideal)(u->Data());
3461  ideal i0;
3462  int r=v->Typ();
3463  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3464  {
3465    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3466    i0->m[0]=(poly)v->Data();
3467    int ii0=idElem(i0); /* size of i0 */
3468    i1=idSimpleAdd(i1,i0); //
3469    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3470    idDelete(&i0);
3471    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3472    tHomog hom=testHomog;
3473
3474    if (w!=NULL)
3475    {
3476      if (!idTestHomModule(i1,currQuotient,w))
3477      {
3478        // no warnung: this is legal, if i in std(i,p)
3479        // is homogeneous, but p not
3480        w=NULL;
3481      }
3482      else
3483      {
3484        w=ivCopy(w);
3485        hom=isHomog;
3486      }
3487    }
3488    BITSET save1;
3489    SI_SAVE_OPT1(save1);
3490    si_opt_1|=Sy_bit(OPT_SB_1);
3491    /* ii0 appears to be the position of the first element of il that
3492       does not belong to the old SB ideal */
3493    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3494    SI_RESTORE_OPT1(save1);
3495    idDelete(&i1);
3496    idSkipZeroes(result);
3497    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3498    res->data = (char *)result;
3499  }
3500  else /*IDEAL/MODULE*/
3501  {
3502    attr *aa=u->Attribute();
3503    attr a=NULL;
3504    if (aa!=NULL) a=(*aa)->Copy();
3505    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3506  }
3507  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3508  return FALSE;
3509}
3510static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3511{
3512  idhdl h=(idhdl)u->data;
3513  int i=(int)(long)v->Data();
3514  if ((0<i) && (i<=IDRING(h)->N))
3515    res->data=omStrDup(IDRING(h)->names[i-1]);
3516  else
3517  {
3518    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3519    return TRUE;
3520  }
3521  return FALSE;
3522}
3523static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3524{
3525// input: u: a list with links of type
3526//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3527//        v: timeout for select in milliseconds
3528//           or 0 for polling
3529// returns: ERROR (via Werror): timeout negative
3530//           -1: the read state of all links is eof
3531//            0: timeout (or polling): none ready
3532//           i>0: (at least) L[i] is ready
3533  lists Lforks = (lists)u->Data();
3534  int t = (int)(long)v->Data();
3535  if(t < 0)
3536  {
3537    WerrorS("negative timeout"); return TRUE;
3538  }
3539  int i = slStatusSsiL(Lforks, t*1000);
3540  if(i == -2) /* error */
3541  {
3542    return TRUE;
3543  }
3544  res->data = (void*)(long)i;
3545  return FALSE;
3546}
3547static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3548{
3549// input: u: a list with links of type
3550//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3551//        v: timeout for select in milliseconds
3552//           or 0 for polling
3553// returns: ERROR (via Werror): timeout negative
3554//           -1: the read state of all links is eof
3555//           0: timeout (or polling): none ready
3556//           1: all links are ready
3557//              (caution: at least one is ready, but some maybe dead)
3558  lists Lforks = (lists)u->CopyD();
3559  int timeout = 1000*(int)(long)v->Data();
3560  if(timeout < 0)
3561  {
3562    WerrorS("negative timeout"); return TRUE;
3563  }
3564  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3565  int i;
3566  int ret = -1;
3567  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3568  {
3569    i = slStatusSsiL(Lforks, timeout);
3570    if(i > 0) /* Lforks[i] is ready */
3571    {
3572      ret = 1;
3573      Lforks->m[i-1].CleanUp();
3574      Lforks->m[i-1].rtyp=DEF_CMD;
3575      Lforks->m[i-1].data=NULL;
3576      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3577    }
3578    else /* terminate the for loop */
3579    {
3580      if(i == -2) /* error */
3581      {
3582        return TRUE;
3583      }
3584      if(i == 0) /* timeout */
3585      {
3586        ret = 0;
3587      }
3588      break;
3589    }
3590  }
3591  Lforks->Clean();
3592  res->data = (void*)(long)ret;
3593  return FALSE;
3594}
3595static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3596{
3597  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3598  return FALSE;
3599}
3600#define jjWRONG2 (proc2)jjWRONG
3601#define jjWRONG3 (proc3)jjWRONG
3602static BOOLEAN jjWRONG(leftv, leftv)
3603{
3604  return TRUE;
3605}
3606
3607/*=================== operations with 1 arg.: static proc =================*/
3608/* must be ordered: first operations for chars (infix ops),
3609 * then alphabetically */
3610
3611static BOOLEAN jjDUMMY(leftv res, leftv u)
3612{
3613  res->data = (char *)u->CopyD();
3614  return FALSE;
3615}
3616static BOOLEAN jjNULL(leftv, leftv)
3617{
3618  return FALSE;
3619}
3620//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3621//{
3622//  res->data = (char *)((int)(long)u->Data()+1);
3623//  return FALSE;
3624//}
3625//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3626//{
3627//  res->data = (char *)((int)(long)u->Data()-1);
3628//  return FALSE;
3629//}
3630static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3631{
3632  if (IDTYP((idhdl)u->data)==INT_CMD)
3633  {
3634    int i=IDINT((idhdl)u->data);
3635    if (iiOp==PLUSPLUS) i++;
3636    else                i--;
3637    IDDATA((idhdl)u->data)=(char *)(long)i;
3638    return FALSE;
3639  }
3640  return TRUE;
3641}
3642static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3643{
3644  number n=(number)u->CopyD(BIGINT_CMD);
3645  n=n_Neg(n,coeffs_BIGINT);
3646  res->data = (char *)n;
3647  return FALSE;
3648}
3649static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3650{
3651  res->data = (char *)(-(long)u->Data());
3652  return FALSE;
3653}
3654static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3655{
3656  number n=(number)u->CopyD(NUMBER_CMD);
3657  n=nNeg(n);
3658  res->data = (char *)n;
3659  return FALSE;
3660}
3661static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3662{
3663  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3664  return FALSE;
3665}
3666static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3667{
3668  poly m1=pISet(-1);
3669  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3670  return FALSE;
3671}
3672static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3673{
3674  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3675  (*iv)*=(-1);
3676  res->data = (char *)iv;
3677  return FALSE;
3678}
3679static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3680{
3681  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3682  (*bim)*=(-1);
3683  res->data = (char *)bim;
3684  return FALSE;
3685}
3686static BOOLEAN jjPROC1(leftv res, leftv u)
3687{
3688  return jjPROC(res,u,NULL);
3689}
3690static BOOLEAN jjBAREISS(leftv res, leftv v)
3691{
3692  //matrix m=(matrix)v->Data();
3693  //lists l=mpBareiss(m,FALSE);
3694  intvec *iv;
3695  ideal m;
3696  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3697  lists l=(lists)omAllocBin(slists_bin);
3698  l->Init(2);
3699  l->m[0].rtyp=MODUL_CMD;
3700  l->m[1].rtyp=INTVEC_CMD;
3701  l->m[0].data=(void *)m;
3702  l->m[1].data=(void *)iv;
3703  res->data = (char *)l;
3704  return FALSE;
3705}
3706//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3707//{
3708//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3709//  ivTriangMat(m);
3710//  res->data = (char *)m;
3711//  return FALSE;
3712//}
3713static BOOLEAN jjBI2N(leftv res, leftv u)
3714{
3715  BOOLEAN bo=FALSE;
3716  number n=(number)u->CopyD();
3717  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3718  if (nMap!=NULL)
3719    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3720  else
3721  {
3722    WerrorS("cannot convert bigint to this field");
3723    bo=TRUE;
3724  }
3725  n_Delete(&n,coeffs_BIGINT);
3726  return bo;
3727}
3728static BOOLEAN jjBI2P(leftv res, leftv u)
3729{
3730  sleftv tmp;
3731  BOOLEAN bo=jjBI2N(&tmp,u);
3732  if (!bo)
3733  {
3734    number n=(number) tmp.data;
3735    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3736    else
3737    {
3738      res->data=(void *)pNSet(n);
3739    }
3740  }
3741  return bo;
3742}
3743static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3744{
3745  return iiExprArithM(res,u,iiOp);
3746}
3747static BOOLEAN jjCHAR(leftv res, leftv v)
3748{
3749  res->data = (char *)(long)rChar((ring)v->Data());
3750  return FALSE;
3751}
3752static BOOLEAN jjCOLS(leftv res, leftv v)
3753{
3754  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3755  return FALSE;
3756}
3757static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3758{
3759  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3760  return FALSE;
3761}
3762static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3763{
3764  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3765  return FALSE;
3766}
3767static BOOLEAN jjCONTENT(leftv res, leftv v)
3768{
3769  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3770  poly p=(poly)v->CopyD(POLY_CMD);
3771  if (p!=NULL) p_Cleardenom(p, currRing);
3772  res->data = (char *)p;
3773  return FALSE;
3774}
3775static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3776{
3777  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3778  return FALSE;
3779}
3780static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3781{
3782  res->data = (char *)(long)nSize((number)v->Data());
3783  return FALSE;
3784}
3785static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3786{
3787  lists l=(lists)v->Data();
3788  res->data = (char *)(long)(lSize(l)+1);
3789  return FALSE;
3790}
3791static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3792{
3793  matrix m=(matrix)v->Data();
3794  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3795  return FALSE;
3796}
3797static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3798{
3799  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3800  return FALSE;
3801}
3802static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3803{
3804  ring r=(ring)v->Data();
3805  int elems=-1;
3806  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3807  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3808  {
3809#ifdef HAVE_FACTORY
3810    extern int ipower ( int b, int n ); /* factory/cf_util */
3811    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3812#else
3813    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3814#endif
3815  }
3816  res->data = (char *)(long)elems;
3817  return FALSE;
3818}
3819static BOOLEAN jjDEG(leftv res, leftv v)
3820{
3821  int dummy;
3822  poly p=(poly)v->Data();
3823  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3824  else res->data=(char *)-1;
3825  return FALSE;
3826}
3827static BOOLEAN jjDEG_M(leftv res, leftv u)
3828{
3829  ideal I=(ideal)u->Data();
3830  int d=-1;
3831  int dummy;
3832  int i;
3833  for(i=IDELEMS(I)-1;i>=0;i--)
3834    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3835  res->data = (char *)(long)d;
3836  return FALSE;
3837}
3838static BOOLEAN jjDEGREE(leftv res, leftv v)
3839{
3840  SPrintStart();
3841#ifdef HAVE_RINGS
3842  if (rField_is_Ring_Z(currRing))
3843  {
3844    ring origR = currRing;
3845    ring tempR = rCopy(origR);
3846    coeffs new_cf=nInitChar(n_Q,NULL);
3847    nKillChar(tempR->cf);
3848    tempR->cf=new_cf;
3849    rComplete(tempR);
3850    ideal vid = (ideal)v->Data();
3851    rChangeCurrRing(tempR);
3852    ideal vv = idrCopyR(vid, origR, currRing);
3853    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3854    vvAsLeftv.rtyp = IDEAL_CMD;
3855    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3856    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3857    assumeStdFlag(&vvAsLeftv);
3858    Print("// NOTE: computation of degree is being performed for\n");
3859    Print("//       generic fibre, that is, over Q\n");
3860    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3861    scDegree(vv,module_w,currQuotient);
3862    idDelete(&vv);
3863    rChangeCurrRing(origR);
3864    rDelete(tempR);
3865  }
3866#endif
3867  assumeStdFlag(v);
3868  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3869  scDegree((ideal)v->Data(),module_w,currQuotient);
3870  char *s=SPrintEnd();
3871  int l=strlen(s)-1;
3872  s[l]='\0';
3873  res->data=(void*)s;
3874  return FALSE;
3875}
3876static BOOLEAN jjDEFINED(leftv res, leftv v)
3877{
3878  if ((v->rtyp==IDHDL)
3879  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3880  {
3881    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3882  }
3883  else if (v->rtyp!=0) res->data=(void *)(-1);
3884  return FALSE;
3885}
3886
3887/// Return the denominator of the input number
3888/// NOTE: the input number is normalized as a side effect
3889static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3890{
3891  number n = reinterpret_cast<number>(v->Data());
3892  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3893  return FALSE;
3894}
3895
3896/// Return the numerator of the input number
3897/// NOTE: the input number is normalized as a side effect
3898static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3899{
3900  number n = reinterpret_cast<number>(v->Data());
3901  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3902  return FALSE;
3903}
3904
3905
3906
3907
3908#ifdef HAVE_FACTORY
3909static BOOLEAN jjDET(leftv res, leftv v)
3910{
3911  matrix m=(matrix)v->Data();
3912  poly p;
3913  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3914  {
3915    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3916    p=sm_CallDet(I, currRing);
3917    idDelete(&I);
3918  }
3919  else
3920    p=singclap_det(m,currRing);
3921  res ->data = (char *)p;
3922  return FALSE;
3923}
3924static BOOLEAN jjDET_BI(leftv res, leftv v)
3925{
3926  bigintmat * m=(bigintmat*)v->Data();
3927  int i,j;
3928  i=m->rows();j=m->cols();
3929  if(i==j)
3930    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3931  else
3932  {
3933    Werror("det of %d x %d bigintmat",i,j);
3934    return TRUE;
3935  }
3936  return FALSE;
3937}
3938static BOOLEAN jjDET_I(leftv res, leftv v)
3939{
3940  intvec * m=(intvec*)v->Data();
3941  int i,j;
3942  i=m->rows();j=m->cols();
3943  if(i==j)
3944    res->data = (char *)(long)singclap_det_i(m,currRing);
3945  else
3946  {
3947    Werror("det of %d x %d intmat",i,j);
3948    return TRUE;
3949  }
3950  return FALSE;
3951}
3952static BOOLEAN jjDET_S(leftv res, leftv v)
3953{
3954  ideal I=(ideal)v->Data();
3955  poly p;
3956  if (IDELEMS(I)<1) return TRUE;
3957  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3958  {
3959    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3960    p=singclap_det(m,currRing);
3961    idDelete((ideal *)&m);
3962  }
3963  else
3964    p=sm_CallDet(I, currRing);
3965  res->data = (char *)p;
3966  return FALSE;
3967}
3968#endif
3969static BOOLEAN jjDIM(leftv res, leftv v)
3970{
3971  assumeStdFlag(v);
3972#ifdef HAVE_RINGS
3973  if (rField_is_Ring(currRing))
3974  {
3975    //ring origR = currRing;
3976    //ring tempR = rCopy(origR);
3977    //coeffs new_cf=nInitChar(n_Q,NULL);
3978    //nKillChar(tempR->cf);
3979    //tempR->cf=new_cf;
3980    //rComplete(tempR);
3981    ideal vid = (ideal)v->Data();
3982    int i = idPosConstant(vid);
3983    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3984    { /* ideal v contains unit; dim = -1 */
3985      res->data = (char *)-1;
3986      return FALSE;
3987    }
3988    //rChangeCurrRing(tempR);
3989    //ideal vv = idrCopyR(vid, origR, currRing);
3990    ideal vv = id_Head(vid,currRing);
3991    /* drop degree zero generator from vv (if any) */
3992    if (i != -1) pDelete(&vv->m[i]);
3993    long d = (long)scDimInt(vv, currQuotient);
3994    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3995    res->data = (char *)d;
3996    idDelete(&vv);
3997    //rChangeCurrRing(origR);
3998    //rDelete(tempR);
3999    return FALSE;
4000  }
4001#endif
4002  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
4003  return FALSE;
4004}
4005static BOOLEAN jjDUMP(leftv, leftv v)
4006{
4007  si_link l = (si_link)v->Data();
4008  if (slDump(l))
4009  {
4010    const char *s;
4011    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4012    else                            s=sNoName;
4013    Werror("cannot dump to `%s`",s);
4014    return TRUE;
4015  }
4016  else
4017    return FALSE;
4018}
4019static BOOLEAN jjE(leftv res, leftv v)
4020{
4021  res->data = (char *)pOne();
4022  int co=(int)(long)v->Data();
4023  if (co>0)
4024  {
4025    pSetComp((poly)res->data,co);
4026    pSetm((poly)res->data);
4027  }
4028  else WerrorS("argument of gen must be positive");
4029  return (co<=0);
4030}
4031static BOOLEAN jjEXECUTE(leftv, leftv v)
4032{
4033  char * d = (char *)v->Data();
4034  char * s = (char *)omAlloc(strlen(d) + 13);
4035  strcpy( s, (char *)d);
4036  strcat( s, "\n;RETURN();\n");
4037  newBuffer(s,BT_execute);
4038  return yyparse();
4039}
4040#ifdef HAVE_FACTORY
4041static BOOLEAN jjFACSTD(leftv res, leftv v)
4042{
4043  lists L=(lists)omAllocBin(slists_bin);
4044  if (rField_is_Zp(currRing)
4045  || rField_is_Q(currRing)
4046  || rField_is_Zp_a(currRing)
4047  || rField_is_Q_a(currRing))
4048  {
4049    ideal_list p,h;
4050    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4051    if (h==NULL)
4052    {
4053      L->Init(1);
4054      L->m[0].data=(char *)idInit(1);
4055      L->m[0].rtyp=IDEAL_CMD;
4056    }
4057    else
4058    {
4059      p=h;
4060      int l=0;
4061      while (p!=NULL) { p=p->next;l++; }
4062      L->Init(l);
4063      l=0;
4064      while(h!=NULL)
4065      {
4066        L->m[l].data=(char *)h->d;
4067        L->m[l].rtyp=IDEAL_CMD;
4068        p=h->next;
4069        omFreeSize(h,sizeof(*h));
4070        h=p;
4071        l++;
4072      }
4073    }
4074  }
4075  else
4076  {
4077    WarnS("no factorization implemented");
4078    L->Init(1);
4079    iiExprArith1(&(L->m[0]),v,STD_CMD);
4080  }
4081  res->data=(void *)L;
4082  return FALSE;
4083}
4084static BOOLEAN jjFAC_P(leftv res, leftv u)
4085{
4086  intvec *v=NULL;
4087  singclap_factorize_retry=0;
4088  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4089  if (f==NULL) return TRUE;
4090  ivTest(v);
4091  lists l=(lists)omAllocBin(slists_bin);
4092  l->Init(2);
4093  l->m[0].rtyp=IDEAL_CMD;
4094  l->m[0].data=(void *)f;
4095  l->m[1].rtyp=INTVEC_CMD;
4096  l->m[1].data=(void *)v;
4097  res->data=(void *)l;
4098  return FALSE;
4099}
4100#endif
4101static BOOLEAN jjGETDUMP(leftv, leftv v)
4102{
4103  si_link l = (si_link)v->Data();
4104  if (slGetDump(l))
4105  {
4106    const char *s;
4107    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4108    else                            s=sNoName;
4109    Werror("cannot get dump from `%s`",s);
4110    return TRUE;
4111  }
4112  else
4113    return FALSE;
4114}
4115static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4116{
4117  assumeStdFlag(v);
4118  ideal I=(ideal)v->Data();
4119  res->data=(void *)iiHighCorner(I,0);
4120  return FALSE;
4121}
4122static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4123{
4124  assumeStdFlag(v);
4125  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4126  BOOLEAN delete_w=FALSE;
4127  ideal I=(ideal)v->Data();
4128  int i;
4129  poly p=NULL,po=NULL;
4130  int rk=id_RankFreeModule(I,currRing);
4131  if (w==NULL)
4132  {
4133    w = new intvec(rk);
4134    delete_w=TRUE;
4135  }
4136  for(i=rk;i>0;i--)
4137  {
4138    p=iiHighCorner(I,i);
4139    if (p==NULL)
4140    {
4141      WerrorS("module must be zero-dimensional");
4142      if (delete_w) delete w;
4143      return TRUE;
4144    }
4145    if (po==NULL)
4146    {
4147      po=p;
4148    }
4149    else
4150    {
4151      // now po!=NULL, p!=NULL
4152      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4153      if (d==0)
4154        d=pLmCmp(po,p);
4155      if (d > 0)
4156      {
4157        pDelete(&p);
4158      }
4159      else // (d < 0)
4160      {
4161        pDelete(&po); po=p;
4162      }
4163    }
4164  }
4165  if (delete_w) delete w;
4166  res->data=(void *)po;
4167  return FALSE;
4168}
4169static BOOLEAN jjHILBERT(leftv, leftv v)
4170{
4171#ifdef HAVE_RINGS
4172  if (rField_is_Ring_Z(currRing))
4173  {
4174    ring origR = currRing;
4175    ring tempR = rCopy(origR);
4176    coeffs new_cf=nInitChar(n_Q,NULL);
4177    nKillChar(tempR->cf);
4178    tempR->cf=new_cf;
4179    rComplete(tempR);
4180    ideal vid = (ideal)v->Data();
4181    rChangeCurrRing(tempR);
4182    ideal vv = idrCopyR(vid, origR, currRing);
4183    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4184    vvAsLeftv.rtyp = IDEAL_CMD;
4185    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4186    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4187    assumeStdFlag(&vvAsLeftv);
4188    Print("// NOTE: computation of Hilbert series etc. is being\n");
4189    Print("//       performed for generic fibre, that is, over Q\n");
4190    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4191    //scHilbertPoly(vv,currQuotient);
4192    hLookSeries(vv,module_w,currQuotient);
4193    idDelete(&vv);
4194    rChangeCurrRing(origR);
4195    rDelete(tempR);
4196    return FALSE;
4197  }
4198#endif
4199  assumeStdFlag(v);
4200  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4201  //scHilbertPoly((ideal)v->Data(),currQuotient);
4202  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4203  return FALSE;
4204}
4205static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4206{
4207#ifdef HAVE_RINGS
4208  if (rField_is_Ring_Z(currRing))
4209  {
4210    Print("// NOTE: computation of Hilbert series etc. is being\n");
4211    Print("//       performed for generic fibre, that is, over Q\n");
4212  }
4213#endif
4214  res->data=(void *)hSecondSeries((intvec *)v->Data());
4215  return FALSE;
4216}
4217static BOOLEAN jjHOMOG1(leftv res, leftv v)
4218{
4219  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4220  ideal v_id=(ideal)v->Data();
4221  if (w==NULL)
4222  {
4223    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4224    if (res->data!=NULL)
4225    {
4226      if (v->rtyp==IDHDL)
4227      {
4228        char *s_isHomog=omStrDup("isHomog");
4229        if (v->e==NULL)
4230          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4231        else
4232          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4233      }
4234      else if (w!=NULL) delete w;
4235    } // if res->data==NULL then w==NULL
4236  }
4237  else
4238  {
4239    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4240    if((res->data==NULL) && (v->rtyp==IDHDL))
4241    {
4242      if (v->e==NULL)
4243        atKill((idhdl)(v->data),"isHomog");
4244      else
4245        atKill((idhdl)(v->LData()),"isHomog");
4246    }
4247  }
4248  return FALSE;
4249}
4250static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4251{
4252  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4253  setFlag(res,FLAG_STD);
4254  return FALSE;
4255}
4256static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4257{
4258  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4259  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4260  if (IDELEMS((ideal)mat)==0)
4261  {
4262    idDelete((ideal *)&mat);
4263    mat=(matrix)idInit(1,1);
4264  }
4265  else
4266  {
4267    MATROWS(mat)=1;
4268    mat->rank=1;
4269    idTest((ideal)mat);
4270  }
4271  res->data=(char *)mat;
4272  return FALSE;
4273}
4274static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4275{
4276  map m=(map)v->CopyD(MAP_CMD);
4277  omFree((ADDRESS)m->preimage);
4278  m->preimage=NULL;
4279  ideal I=(ideal)m;
4280  I->rank=1;
4281  res->data=(char *)I;
4282  return FALSE;
4283}
4284static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4285{
4286  if (currRing!=NULL)
4287  {
4288    ring q=(ring)v->Data();
4289    if (rSamePolyRep(currRing, q))
4290    {
4291      if (q->qideal==NULL)
4292        res->data=(char *)idInit(1,1);
4293      else
4294        res->data=(char *)idCopy(q->qideal);
4295      return FALSE;
4296    }
4297  }
4298  WerrorS("can only get ideal from identical qring");
4299  return TRUE;
4300}
4301static BOOLEAN jjIm2Iv(leftv res, leftv v)
4302{
4303  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4304  iv->makeVector();
4305  res->data = iv;
4306  return FALSE;
4307}
4308static BOOLEAN jjIMPART(leftv res, leftv v)
4309{
4310  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4311  return FALSE;
4312}
4313static BOOLEAN jjINDEPSET(leftv res, leftv v)
4314{
4315  assumeStdFlag(v);
4316  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4317  return FALSE;
4318}
4319static BOOLEAN jjINTERRED(leftv res, leftv v)
4320{
4321  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4322  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4323  res->data = result;
4324  return FALSE;
4325}
4326static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4327{
4328  res->data = (char *)(long)pVar((poly)v->Data());
4329  return FALSE;
4330}
4331static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4332{
4333  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4334  return FALSE;
4335}
4336static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4337{
4338  res->data = (char *)0;
4339  return FALSE;
4340}
4341static BOOLEAN jjJACOB_P(leftv res, leftv v)
4342{
4343  ideal i=idInit(currRing->N,1);
4344  int k;
4345  poly p=(poly)(v->Data());
4346  for (k=currRing->N;k>0;k--)
4347  {
4348    i->m[k-1]=pDiff(p,k);
4349  }
4350  res->data = (char *)i;
4351  return FALSE;
4352}
4353/*2
4354 * compute Jacobi matrix of a module/matrix
4355 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4356 * where Mt := transpose(M)
4357 * Note that this is consistent with the current conventions for jacob in Singular,
4358 * whereas M2 computes its transposed.
4359 */
4360static BOOLEAN jjJACOB_M(leftv res, leftv a)
4361{
4362  ideal id = (ideal)a->Data();
4363  id = idTransp(id);
4364  int W = IDELEMS(id);
4365
4366  ideal result = idInit(W * currRing->N, id->rank);
4367  poly *p = result->m;
4368
4369  for( int v = 1; v <= currRing->N; v++ )
4370  {
4371    poly* q = id->m;
4372    for( int i = 0; i < W; i++, p++, q++ )
4373      *p = pDiff( *q, v );
4374  }
4375  idDelete(&id);
4376
4377  res->data = (char *)result;
4378  return FALSE;
4379}
4380
4381
4382static BOOLEAN jjKBASE(leftv res, leftv v)
4383{
4384  assumeStdFlag(v);
4385  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4386  return FALSE;
4387}
4388#ifdef MDEBUG
4389static BOOLEAN jjpHead(leftv res, leftv v)
4390{
4391  res->data=(char *)pHead((poly)v->Data());
4392  return FALSE;
4393}
4394#endif
4395static BOOLEAN jjL2R(leftv res, leftv v)
4396{
4397  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4398  if (res->data != NULL)
4399    return FALSE;
4400  else
4401    return TRUE;
4402}
4403static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4404{
4405  poly p=(poly)v->Data();
4406  if (p==NULL)
4407  {
4408    res->data=(char *)nInit(0);
4409  }
4410  else
4411  {
4412    res->data=(char *)nCopy(pGetCoeff(p));
4413  }
4414  return FALSE;
4415}
4416static BOOLEAN jjLEADEXP(leftv res, leftv v)
4417{
4418  poly p=(poly)v->Data();
4419  int s=currRing->N;
4420  if (v->Typ()==VECTOR_CMD) s++;
4421  intvec *iv=new intvec(s);
4422  if (p!=NULL)
4423  {
4424    for(int i = currRing->N;i;i--)
4425    {
4426      (*iv)[i-1]=pGetExp(p,i);
4427    }
4428    if (s!=currRing->N)
4429      (*iv)[currRing->N]=pGetComp(p);
4430  }
4431  res->data=(char *)iv;
4432  return FALSE;
4433}
4434static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4435{
4436  poly p=(poly)v->Data();
4437  if (p == NULL)
4438  {
4439    res->data = (char*) NULL;
4440  }
4441  else
4442  {
4443    poly lm = pLmInit(p);
4444    pSetCoeff(lm, nInit(1));
4445    res->data = (char*) lm;
4446  }
4447  return FALSE;
4448}
4449static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4450{
4451  return jjLOAD((char*)v->Data(),FALSE);
4452}
4453static BOOLEAN jjLISTRING(leftv res, leftv v)
4454{
4455  ring r=rCompose((lists)v->Data());
4456  if (r==NULL) return TRUE;
4457  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4458  res->data=(char *)r;
4459  return FALSE;
4460}
4461#if SIZEOF_LONG == 8
4462static number jjLONG2N(long d)
4463{
4464  int i=(int)d;
4465  if ((long)i == d)
4466  {
4467    return n_Init(i, coeffs_BIGINT);
4468  }
4469  else
4470  {
4471     struct snumber_dummy
4472     {
4473      mpz_t z;
4474      mpz_t n;
4475      #if defined(LDEBUG)
4476      int debug;
4477      #endif
4478      BOOLEAN s;
4479    };
4480    typedef struct snumber_dummy  *number_dummy;
4481
4482    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4483    #if defined(LDEBUG)
4484    z->debug=123456;
4485    #endif
4486    z->s=3;
4487    mpz_init_set_si(z->z,d);
4488    return (number)z;
4489  }
4490}
4491#else
4492#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4493#endif
4494static BOOLEAN jjPFAC1(leftv res, leftv v)
4495{
4496  /* call method jjPFAC2 with second argument = 0 (meaning that no
4497     valid bound for the prime factors has been given) */
4498  sleftv tmp;
4499  memset(&tmp, 0, sizeof(tmp));
4500  tmp.rtyp = INT_CMD;
4501  return jjPFAC2(res, v, &tmp);
4502}
4503static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4504{
4505  /* computes the LU-decomposition of a matrix M;
4506     i.e., M = P * L * U, where
4507        - P is a row permutation matrix,
4508        - L is in lower triangular form,
4509        - U is in upper row echelon form
4510     Then, we also have P * M = L * U.
4511     A list [P, L, U] is returned. */
4512  matrix mat = (const matrix)v->Data();
4513  if (!idIsConstant((ideal)mat))
4514  {
4515    WerrorS("matrix must be constant");
4516    return TRUE;
4517  }
4518  matrix pMat;
4519  matrix lMat;
4520  matrix uMat;
4521
4522  luDecomp(mat, pMat, lMat, uMat);
4523
4524  lists ll = (lists)omAllocBin(slists_bin);
4525  ll->Init(3);
4526  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4527  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4528  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4529  res->data=(char*)ll;
4530
4531  return FALSE;
4532}
4533static BOOLEAN jjMEMORY(leftv res, leftv v)
4534{
4535  omUpdateInfo();
4536  switch(((int)(long)v->Data()))
4537  {
4538  case 0:
4539    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4540    break;
4541  case 1:
4542    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4543    break;
4544  case 2:
4545    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4546    break;
4547  default:
4548    omPrintStats(stdout);
4549    omPrintInfo(stdout);
4550    omPrintBinStats(stdout);
4551    res->data = (char *)0;
4552    res->rtyp = NONE;
4553  }
4554  return FALSE;
4555  res->data = (char *)0;
4556  return FALSE;
4557}
4558//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4559//{
4560//  return jjMONITOR2(res,v,NULL);
4561//}
4562static BOOLEAN jjMSTD(leftv res, leftv v)
4563{
4564  int t=v->Typ();
4565  ideal r,m;
4566  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4567  lists l=(lists)omAllocBin(slists_bin);
4568  l->Init(2);
4569  l->m[0].rtyp=t;
4570  l->m[0].data=(char *)r;
4571  setFlag(&(l->m[0]),FLAG_STD);
4572  l->m[1].rtyp=t;
4573  l->m[1].data=(char *)m;
4574  res->data=(char *)l;
4575  return FALSE;
4576}
4577static BOOLEAN jjMULT(leftv res, leftv v)
4578{
4579  assumeStdFlag(v);
4580  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4581  return FALSE;
4582}
4583static BOOLEAN jjMINRES_R(leftv res, leftv v)
4584{
4585  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4586
4587  syStrategy tmp=(syStrategy)v->Data();
4588  tmp = syMinimize(tmp); // enrich itself!
4589
4590  res->data=(char *)tmp;
4591
4592  if (weights!=NULL)
4593    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4594
4595  return FALSE;
4596}
4597static BOOLEAN jjN2BI(leftv res, leftv v)
4598{
4599  number n,i; i=(number)v->Data();
4600  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4601  if (nMap!=NULL)
4602    n=nMap(i,currRing->cf,coeffs_BIGINT);
4603  else goto err;
4604  res->data=(void *)n;
4605  return FALSE;
4606err:
4607  WerrorS("cannot convert to bigint"); return TRUE;
4608}
4609static BOOLEAN jjNAMEOF(leftv res, leftv v)
4610{
4611  res->data = (char *)v->name;
4612  if (res->data==NULL) res->data=omStrDup("");
4613  v->name=NULL;
4614  return FALSE;
4615}
4616static BOOLEAN jjNAMES(leftv res, leftv v)
4617{
4618  res->data=ipNameList(((ring)v->Data())->idroot);
4619  return FALSE;
4620}
4621static BOOLEAN jjNAMES_I(leftv res, leftv v)
4622{
4623  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4624  return FALSE;
4625}
4626static BOOLEAN jjNVARS(leftv res, leftv v)
4627{
4628  res->data = (char *)(long)(((ring)(v->Data()))->N);
4629  return FALSE;
4630}
4631static BOOLEAN jjOpenClose(leftv, leftv v)
4632{
4633  si_link l=(si_link)v->Data();
4634  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4635  else                return slClose(l);
4636}
4637static BOOLEAN jjORD(leftv res, leftv v)
4638{
4639  poly p=(poly)v->Data();
4640  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4641  return FALSE;
4642}
4643static BOOLEAN jjPAR1(leftv res, leftv v)
4644{
4645  int i=(int)(long)v->Data();
4646  int p=0;
4647  p=rPar(currRing);
4648  if ((0<i) && (i<=p))
4649  {
4650    res->data=(char *)n_Param(i,currRing);
4651  }
4652  else
4653  {
4654    Werror("par number %d out of range 1..%d",i,p);
4655    return TRUE;
4656  }
4657  return FALSE;
4658}
4659static BOOLEAN jjPARDEG(leftv res, leftv v)
4660{
4661  number nn=(number)v->Data();
4662  res->data = (char *)(long)n_ParDeg(nn, currRing);
4663  return FALSE;
4664}
4665static BOOLEAN jjPARSTR1(leftv res, leftv v)
4666{
4667  if (currRing==NULL)
4668  {
4669    WerrorS("no ring active");
4670    return TRUE;
4671  }
4672  int i=(int)(long)v->Data();
4673  int p=0;
4674  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4675    res->data=omStrDup(rParameter(currRing)[i-1]);
4676  else
4677  {
4678    Werror("par number %d out of range 1..%d",i,p);
4679    return TRUE;
4680  }
4681  return FALSE;
4682}
4683static BOOLEAN jjP2BI(leftv res, leftv v)
4684{
4685  poly p=(poly)v->Data();
4686  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4687  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4688  {
4689    WerrorS("poly must be constant");
4690    return TRUE;
4691  }
4692  number i=pGetCoeff(p);
4693  number n;
4694  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4695  if (nMap!=NULL)
4696    n=nMap(i,currRing->cf,coeffs_BIGINT);
4697  else goto err;
4698  res->data=(void *)n;
4699  return FALSE;
4700err:
4701  WerrorS("cannot convert to bigint"); return TRUE;
4702}
4703static BOOLEAN jjP2I(leftv res, leftv v)
4704{
4705  poly p=(poly)v->Data();
4706  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4707  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4708  {
4709    WerrorS("poly must be constant");
4710    return TRUE;
4711  }
4712  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4713  return FALSE;
4714}
4715static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4716{
4717  map mapping=(map)v->Data();
4718  syMake(res,omStrDup(mapping->preimage));
4719  return FALSE;
4720}
4721static BOOLEAN jjPRIME(leftv res, leftv v)
4722{
4723  int i = IsPrime((int)(long)(v->Data()));
4724  res->data = (char *)(long)(i > 1 ? i : 2);
4725  return FALSE;
4726}
4727static BOOLEAN jjPRUNE(leftv res, leftv v)
4728{
4729  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4730  ideal v_id=(ideal)v->Data();
4731  if (w!=NULL)
4732  {
4733    if (!idTestHomModule(v_id,currQuotient,w))
4734    {
4735      WarnS("wrong weights");
4736      w=NULL;
4737      // and continue at the non-homog case below
4738    }
4739    else
4740    {
4741      w=ivCopy(w);
4742      intvec **ww=&w;
4743      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4744      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4745      return FALSE;
4746    }
4747  }
4748  res->data = (char *)idMinEmbedding(v_id);
4749  return FALSE;
4750}
4751static BOOLEAN jjP2N(leftv res, leftv v)
4752{
4753  number n;
4754  poly p;
4755  if (((p=(poly)v->Data())!=NULL)
4756  && (pIsConstant(p)))
4757  {
4758    n=nCopy(pGetCoeff(p));
4759  }
4760  else
4761  {
4762    n=nInit(0);
4763  }
4764  res->data = (char *)n;
4765  return FALSE;
4766}
4767static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4768{
4769  char *s= (char *)v->Data();
4770  int i = 1;
4771  for(i=0; i<sArithBase.nCmdUsed; i++)
4772  {
4773    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4774    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4775    {
4776      res->data = (char *)1;
4777      return FALSE;
4778    }
4779  }
4780  //res->data = (char *)0;
4781  return FALSE;
4782}
4783static BOOLEAN jjRANK1(leftv res, leftv v)
4784{
4785  matrix m =(matrix)v->Data();
4786  int rank = luRank(m, 0);
4787  res->data =(char *)(long)rank;
4788  return FALSE;
4789}
4790static BOOLEAN jjREAD(leftv res, leftv v)
4791{
4792  return jjREAD2(res,v,NULL);
4793}
4794static BOOLEAN jjREGULARITY(leftv res, leftv v)
4795{
4796  res->data = (char *)(long)iiRegularity((lists)v->Data());
4797  return FALSE;
4798}
4799static BOOLEAN jjREPART(leftv res, leftv v)
4800{
4801  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4802  return FALSE;
4803}
4804static BOOLEAN jjRINGLIST(leftv res, leftv v)
4805{
4806  ring r=(ring)v->Data();
4807  if (r!=NULL)
4808    res->data = (char *)rDecompose((ring)v->Data());
4809  return (r==NULL)||(res->data==NULL);
4810}
4811static BOOLEAN jjROWS(leftv res, leftv v)
4812{
4813  ideal i = (ideal)v->Data();
4814  res->data = (char *)i->rank;
4815  return FALSE;
4816}
4817static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4818{
4819  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4820  return FALSE;
4821}
4822static BOOLEAN jjROWS_IV(leftv res, leftv v)
4823{
4824  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4825  return FALSE;
4826}
4827static BOOLEAN jjRPAR(leftv res, leftv v)
4828{
4829  res->data = (char *)(long)rPar(((ring)v->Data()));
4830  return FALSE;
4831}
4832static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4833{
4834#ifdef HAVE_PLURAL
4835  const bool bIsSCA = rIsSCA(currRing);
4836#else
4837  const bool bIsSCA = false;
4838#endif
4839
4840  if ((currQuotient!=NULL) && !bIsSCA)
4841  {
4842    WerrorS("qring not supported by slimgb at the moment");
4843    return TRUE;
4844  }
4845  if (rHasLocalOrMixedOrdering_currRing())
4846  {
4847    WerrorS("ordering must be global for slimgb");
4848    return TRUE;
4849  }
4850  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4851  // tHomog hom=testHomog;
4852  ideal u_id=(ideal)u->Data();
4853  if (w!=NULL)
4854  {
4855    if (!idTestHomModule(u_id,currQuotient,w))
4856    {
4857      WarnS("wrong weights");
4858      w=NULL;
4859    }
4860    else
4861    {
4862      w=ivCopy(w);
4863      // hom=isHomog;
4864    }
4865  }
4866
4867  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4868  res->data=(char *)t_rep_gb(currRing,
4869    u_id,u_id->rank);
4870  //res->data=(char *)t_rep_gb(currRing, u_id);
4871
4872  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4873  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4874  return FALSE;
4875}
4876static BOOLEAN jjSBA(leftv res, leftv v)
4877{
4878  ideal result;
4879  ideal v_id=(ideal)v->Data();
4880  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4881  tHomog hom=testHomog;
4882  if (w!=NULL)
4883  {
4884    if (!idTestHomModule(v_id,currQuotient,w))
4885    {
4886      WarnS("wrong weights");
4887      w=NULL;
4888    }
4889    else
4890    {
4891      hom=isHomog;
4892      w=ivCopy(w);
4893    }
4894  }
4895  result=kSba(v_id,currQuotient,hom,&w,1,0);
4896  idSkipZeroes(result);
4897  res->data = (char *)result;
4898  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4899  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4900  return FALSE;
4901}
4902static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4903{
4904  ideal result;
4905  ideal v_id=(ideal)v->Data();
4906  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4907  tHomog hom=testHomog;
4908  if (w!=NULL)
4909  {
4910    if (!idTestHomModule(v_id,currQuotient,w))
4911    {
4912      WarnS("wrong weights");
4913      w=NULL;
4914    }
4915    else
4916    {
4917      hom=isHomog;
4918      w=ivCopy(w);
4919    }
4920  }
4921  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4922  idSkipZeroes(result);
4923  res->data = (char *)result;
4924  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4925  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4926  return FALSE;
4927}
4928static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4929{
4930  ideal result;
4931  ideal v_id=(ideal)v->Data();
4932  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4933  tHomog hom=testHomog;
4934  if (w!=NULL)
4935  {
4936    if (!idTestHomModule(v_id,currQuotient,w))
4937    {
4938      WarnS("wrong weights");
4939      w=NULL;
4940    }
4941    else
4942    {
4943      hom=isHomog;
4944      w=ivCopy(w);
4945    }
4946  }
4947  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4948  idSkipZeroes(result);
4949  res->data = (char *)result;
4950  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4951  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4952  return FALSE;
4953}
4954static BOOLEAN jjSTD(leftv res, leftv v)
4955{
4956  ideal result;
4957  ideal v_id=(ideal)v->Data();
4958  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4959  tHomog hom=testHomog;
4960  if (w!=NULL)
4961  {
4962    if (!idTestHomModule(v_id,currQuotient,w))
4963    {
4964      WarnS("wrong weights");
4965      w=NULL;
4966    }
4967    else
4968    {
4969      hom=isHomog;
4970      w=ivCopy(w);
4971    }
4972  }
4973  result=kStd(v_id,currQuotient,hom,&w);
4974  idSkipZeroes(result);
4975  res->data = (char *)result;
4976  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4977  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4978  return FALSE;
4979}
4980static BOOLEAN jjSort_Id(leftv res, leftv v)
4981{
4982  res->data = (char *)idSort((ideal)v->Data());
4983  return FALSE;
4984}
4985#ifdef HAVE_FACTORY
4986static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4987{
4988  singclap_factorize_retry=0;
4989  intvec *v=NULL;
4990  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4991  if (f==NULL) return TRUE;
4992  ivTest(v);
4993  lists l=(lists)omAllocBin(slists_bin);
4994  l->Init(2);
4995  l->m[0].rtyp=IDEAL_CMD;
4996  l->m[0].data=(void *)f;
4997  l->m[1].rtyp=INTVEC_CMD;
4998  l->m[1].data=(void *)v;
4999  res->data=(void *)l;
5000  return FALSE;
5001}
5002#endif
5003#if 1
5004static BOOLEAN jjSYZYGY(leftv res, leftv v)
5005{
5006  intvec *w=NULL;
5007  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5008  if (w!=NULL) delete w;
5009  return FALSE;
5010}
5011#else
5012// activate, if idSyz handle module weights correctly !
5013static BOOLEAN jjSYZYGY(leftv res, leftv v)
5014{
5015  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5016  ideal v_id=(ideal)v->Data();
5017  tHomog hom=testHomog;
5018  int add_row_shift=0;
5019  if (w!=NULL)
5020  {
5021    w=ivCopy(w);
5022    add_row_shift=w->min_in();
5023    (*w)-=add_row_shift;
5024    if (idTestHomModule(v_id,currQuotient,w))
5025      hom=isHomog;
5026    else
5027    {
5028      //WarnS("wrong weights");
5029      delete w; w=NULL;
5030      hom=testHomog;
5031    }
5032  }
5033  res->data = (char *)idSyzygies(v_id,hom,&w);
5034  if (w!=NULL)
5035  {
5036    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5037  }
5038  return FALSE;
5039}
5040#endif
5041static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5042{
5043  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5044  return FALSE;
5045}
5046static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5047{
5048  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5049  return FALSE;
5050}
5051static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5052{
5053  res->data = (char *)ivTranp((intvec*)(v->Data()));
5054  return FALSE;
5055}
5056#ifdef HAVE_PLURAL
5057static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5058{
5059  ring    r = (ring)a->Data();
5060  //if (rIsPluralRing(r))
5061  if (r->OrdSgn==1)
5062  {
5063    res->data = rOpposite(r);
5064  }
5065  else
5066  {
5067    WarnS("opposite only for global orderings");
5068    res->data = rCopy(r);
5069  }
5070  return FALSE;
5071}
5072static BOOLEAN jjENVELOPE(leftv res, leftv a)
5073{
5074  ring    r = (ring)a->Data();
5075  if (rIsPluralRing(r))
5076  {
5077    //    ideal   i;
5078//     if (a->rtyp == QRING_CMD)
5079//     {
5080//       i = r->qideal;
5081//       r->qideal = NULL;
5082//     }
5083    ring s = rEnvelope(r);
5084//     if (a->rtyp == QRING_CMD)
5085//     {
5086//       ideal is  = idOppose(r,i); /* twostd? */
5087//       is        = idAdd(is,i);
5088//       s->qideal = i;
5089//     }
5090    res->data = s;
5091  }
5092  else  res->data = rCopy(r);
5093  return FALSE;
5094}
5095static BOOLEAN jjTWOSTD(leftv res, leftv a)
5096{
5097  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5098  else  res->data=(ideal)a->CopyD();
5099  setFlag(res,FLAG_STD);
5100  setFlag(res,FLAG_TWOSTD);
5101  return FALSE;
5102}
5103#endif
5104
5105static BOOLEAN jjTYPEOF(leftv res, leftv v)
5106{
5107  int t=(int)(long)v->data;
5108  switch (t)
5109  {
5110    case INT_CMD:        res->data=omStrDup("int"); break;
5111    case POLY_CMD:       res->data=omStrDup("poly"); break;
5112    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5113    case STRING_CMD:     res->data=omStrDup("string"); break;
5114    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5115    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5116    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5117    case MODUL_CMD:      res->data=omStrDup("module"); break;
5118    case MAP_CMD:        res->data=omStrDup("map"); break;
5119    case PROC_CMD:       res->data=omStrDup("proc"); break;
5120    case RING_CMD:       res->data=omStrDup("ring"); break;
5121    case QRING_CMD:      res->data=omStrDup("qring"); break;
5122    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5123    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5124    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5125    case LIST_CMD:       res->data=omStrDup("list"); break;
5126    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5127    case LINK_CMD:       res->data=omStrDup("link"); break;
5128    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5129    case DEF_CMD:
5130    case NONE:           res->data=omStrDup("none"); break;
5131    default:
5132    {
5133      if (t>MAX_TOK)
5134        res->data=omStrDup(getBlackboxName(t));
5135      else
5136        res->data=omStrDup("?unknown type?");
5137      break;
5138    }
5139  }
5140  return FALSE;
5141}
5142static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5143{
5144  res->data=(char *)pIsUnivariate((poly)v->Data());
5145  return FALSE;
5146}
5147static BOOLEAN jjVAR1(leftv res, leftv v)
5148{
5149  int i=(int)(long)v->Data();
5150  if ((0<i) && (i<=currRing->N))
5151  {
5152    poly p=pOne();
5153    pSetExp(p,i,1);
5154    pSetm(p);
5155    res->data=(char *)p;
5156  }
5157  else
5158  {
5159    Werror("var number %d out of range 1..%d",i,currRing->N);
5160    return TRUE;
5161  }
5162  return FALSE;
5163}
5164static BOOLEAN jjVARSTR1(leftv res, leftv v)
5165{
5166  if (currRing==NULL)
5167  {
5168    WerrorS("no ring active");
5169    return TRUE;
5170  }
5171  int i=(int)(long)v->Data();
5172  if ((0<i) && (i<=currRing->N))
5173    res->data=omStrDup(currRing->names[i-1]);
5174  else
5175  {
5176    Werror("var number %d out of range 1..%d",i,currRing->N);
5177    return TRUE;
5178  }
5179  return FALSE;
5180}
5181static BOOLEAN jjVDIM(leftv res, leftv v)
5182{
5183  assumeStdFlag(v);
5184  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5185  return FALSE;
5186}
5187BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5188{
5189// input: u: a list with links of type
5190//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5191// returns: -1:  the read state of all links is eof
5192//          i>0: (at least) u[i] is ready
5193  lists Lforks = (lists)u->Data();
5194  int i = slStatusSsiL(Lforks, -1);
5195  if(i == -2) /* error */
5196  {
5197    return TRUE;
5198  }
5199  res->data = (void*)(long)i;
5200  return FALSE;
5201}
5202BOOLEAN jjWAITALL1(leftv res, leftv u)
5203{
5204// input: u: a list with links of type
5205//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5206// returns: -1: the read state of all links is eof
5207//           1: all links are ready
5208//              (caution: at least one is ready, but some maybe dead)
5209  lists Lforks = (lists)u->CopyD();
5210  int i;
5211  int j = -1;
5212  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5213  {
5214    i = slStatusSsiL(Lforks, -1);
5215    if(i == -2) /* error */
5216    {
5217      return TRUE;
5218    }
5219    if(i == -1)
5220    {
5221      break;
5222    }
5223    j = 1;
5224    Lforks->m[i-1].CleanUp();
5225    Lforks->m[i-1].rtyp=DEF_CMD;
5226    Lforks->m[i-1].data=NULL;
5227  }
5228  res->data = (void*)(long)j;
5229  Lforks->Clean();
5230  return FALSE;
5231}
5232
5233BOOLEAN jjLOAD(char *s, BOOLEAN autoexport)
5234{
5235  char libnamebuf[256];
5236  lib_types LT = type_of_LIB(s, libnamebuf);
5237
5238#ifdef HAVE_DYNAMIC_LOADING
5239  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5240#endif /* HAVE_DYNAMIC_LOADING */
5241  switch(LT)
5242  {
5243      default:
5244      case LT_NONE:
5245        Werror("%s: unknown type", s);
5246        break;
5247      case LT_NOTFOUND:
5248        Werror("cannot open %s", s);
5249        break;
5250
5251      case LT_SINGULAR:
5252      {
5253        char *plib = iiConvName(s);
5254        idhdl pl = IDROOT->get(plib,0);
5255        if (pl==NULL)
5256        {
5257          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5258          IDPACKAGE(pl)->language = LANG_SINGULAR;
5259          IDPACKAGE(pl)->libname=omStrDup(plib);
5260        }
5261        else if (IDTYP(pl)!=PACKAGE_CMD)
5262        {
5263          Werror("can not create package `%s`",plib);
5264          omFree(plib);
5265          return TRUE;
5266        }
5267        package savepack=currPack;
5268        currPack=IDPACKAGE(pl);
5269        IDPACKAGE(pl)->loaded=TRUE;
5270        char libnamebuf[256];
5271        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5272        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5273        currPack=savepack;
5274        IDPACKAGE(pl)->loaded=(!bo);
5275        return bo;
5276      }
5277      case LT_BUILTIN:
5278        SModulFunc_t iiGetBuiltinModInit(char*);
5279        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5280      case LT_MACH_O:
5281      case LT_ELF:
5282      case LT_HPUX:
5283#ifdef HAVE_DYNAMIC_LOADING
5284        return load_modules(s, libnamebuf, autoexport);
5285#else /* HAVE_DYNAMIC_LOADING */
5286        WerrorS("Dynamic modules are not supported by this version of Singular");
5287        break;
5288#endif /* HAVE_DYNAMIC_LOADING */
5289  }
5290  return TRUE;
5291}
5292
5293#ifdef INIT_BUG
5294#define XS(A) -((short)A)
5295#define jjstrlen       (proc1)1
5296#define jjpLength      (proc1)2
5297#define jjidElem       (proc1)3
5298#define jjmpDetBareiss (proc1)4
5299#define jjidFreeModule (proc1)5
5300#define jjidVec2Ideal  (proc1)6
5301#define jjrCharStr     (proc1)7
5302#ifndef MDEBUG
5303#define jjpHead        (proc1)8
5304#endif
5305#define jjidMinBase    (proc1)11
5306#define jjsyMinBase    (proc1)12
5307#define jjpMaxComp     (proc1)13
5308#define jjmpTrace      (proc1)14
5309#define jjmpTransp     (proc1)15
5310#define jjrOrdStr      (proc1)16
5311#define jjrVarStr      (proc1)18
5312#define jjrParStr      (proc1)19
5313#define jjCOUNT_RES    (proc1)22
5314#define jjDIM_R        (proc1)23
5315#define jjidTransp     (proc1)24
5316
5317extern struct sValCmd1 dArith1[];
5318void jjInitTab1()
5319{
5320  int i=0;
5321  for (;dArith1[i].cmd!=0;i++)
5322  {
5323    if (dArith1[i].res<0)
5324    {
5325      switch ((int)dArith1[i].p)
5326      {
5327        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5328        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5329        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5330        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5331#ifndef HAVE_FACTORY
5332        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5333#endif
5334        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5335        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5336#ifndef MDEBUG
5337        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5338#endif
5339        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5340        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5341        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5342        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5343        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5344        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5345        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5346        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5347        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5348        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5349        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5350        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5351      }
5352    }
5353  }
5354}
5355#else
5356#if defined(PROC_BUG)
5357#define XS(A) A
5358static BOOLEAN jjstrlen(leftv res, leftv v)
5359{
5360  res->data = (char *)strlen((char *)v->Data());
5361  return FALSE;
5362}
5363static BOOLEAN jjpLength(leftv res, leftv v)
5364{
5365  res->data = (char *)pLength((poly)v->Data());
5366  return FALSE;
5367}
5368static BOOLEAN jjidElem(leftv res, leftv v)
5369{
5370  res->data = (char *)idElem((ideal)v->Data());
5371  return FALSE;
5372}
5373static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5374{
5375  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5376  return FALSE;
5377}
5378static BOOLEAN jjidFreeModule(leftv res, leftv v)
5379{
5380  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5381  return FALSE;
5382}
5383static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5384{
5385  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5386  return FALSE;
5387}
5388static BOOLEAN jjrCharStr(leftv res, leftv v)
5389{
5390  res->data = rCharStr((ring)v->Data());
5391  return FALSE;
5392}
5393#ifndef MDEBUG
5394static BOOLEAN jjpHead(leftv res, leftv v)
5395{
5396  res->data = (char *)pHead((poly)v->Data());
5397  return FALSE;
5398}
5399#endif
5400static BOOLEAN jjidHead(leftv res, leftv v)
5401{
5402  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5403  return FALSE;
5404}
5405static BOOLEAN jjidMinBase(leftv res, leftv v)
5406{
5407  res->data = (char *)idMinBase((ideal)v->Data());
5408  return FALSE;
5409}
5410static BOOLEAN jjsyMinBase(leftv res, leftv v)
5411{
5412  res->data = (char *)syMinBase((ideal)v->Data());
5413  return FALSE;
5414}
5415static BOOLEAN jjpMaxComp(leftv res, leftv v)
5416{
5417  res->data = (char *)pMaxComp((poly)v->Data());
5418  return FALSE;
5419}
5420static BOOLEAN jjmpTrace(leftv res, leftv v)
5421{
5422  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5423  return FALSE;
5424}
5425static BOOLEAN jjmpTransp(leftv res, leftv v)
5426{
5427  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5428  return FALSE;
5429}
5430static BOOLEAN jjrOrdStr(leftv res, leftv v)
5431{
5432  res->data = rOrdStr((ring)v->Data());
5433  return FALSE;
5434}
5435static BOOLEAN jjrVarStr(leftv res, leftv v)
5436{
5437  res->data = rVarStr((ring)v->Data());
5438  return FALSE;
5439}
5440static BOOLEAN jjrParStr(leftv res, leftv v)
5441{
5442  res->data = rParStr((ring)v->Data());
5443  return FALSE;
5444}
5445static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5446{
5447  res->data=(char *)sySize((syStrategy)v->Data());
5448  return FALSE;
5449}
5450static BOOLEAN jjDIM_R(leftv res, leftv v)
5451{
5452  res->data = (char *)syDim((syStrategy)v->Data());
5453  return FALSE;
5454}
5455static BOOLEAN jjidTransp(leftv res, leftv v)
5456{
5457  res->data = (char *)idTransp((ideal)v->Data());
5458  return FALSE;
5459}
5460#else
5461#define XS(A)          -((short)A)
5462#define jjstrlen       (proc1)strlen
5463#define jjpLength      (proc1)pLength
5464#define jjidElem       (proc1)idElem
5465#define jjmpDetBareiss (proc1)mpDetBareiss
5466#define jjidFreeModule (proc1)idFreeModule
5467#define jjidVec2Ideal  (proc1)idVec2Ideal
5468#define jjrCharStr     (proc1)rCharStr
5469#ifndef MDEBUG
5470#define jjpHead        (proc1)pHeadProc
5471#endif
5472#define jjidHead       (proc1)idHead
5473#define jjidMinBase    (proc1)idMinBase
5474#define jjsyMinBase    (proc1)syMinBase
5475#define jjpMaxComp     (proc1)pMaxCompProc
5476#define jjrOrdStr      (proc1)rOrdStr
5477#define jjrVarStr      (proc1)rVarStr
5478#define jjrParStr      (proc1)rParStr
5479#define jjCOUNT_RES    (proc1)sySize
5480#define jjDIM_R        (proc1)syDim
5481#define jjidTransp     (proc1)idTransp
5482#endif
5483#endif
5484static BOOLEAN jjnInt(leftv res, leftv u)
5485{
5486  number n=(number)u->Data();
5487  res->data=(char *)(long)n_Int(n,currRing->cf);
5488  return FALSE;
5489}
5490static BOOLEAN jjnlInt(leftv res, leftv u)
5491{
5492  number n=(number)u->Data();
5493  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5494  return FALSE;
5495}
5496/*=================== operations with 3 args.: static proc =================*/
5497/* must be ordered: first operations for chars (infix ops),
5498 * then alphabetically */
5499static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5500{
5501  char *s= (char *)u->Data();
5502  int   r = (int)(long)v->Data();
5503  int   c = (int)(long)w->Data();
5504  int l = strlen(s);
5505
5506  if ( (r<1) || (r>l) || (c<0) )
5507  {
5508    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5509    return TRUE;
5510  }
5511  res->data = (char *)omAlloc((long)(c+1));
5512  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5513  return FALSE;
5514}
5515static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5516{
5517  intvec *iv = (intvec *)u->Data();
5518  int   r = (int)(long)v->Data();
5519  int   c = (int)(long)w->Data();
5520  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5521  {
5522    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5523           r,c,u->Fullname(),iv->rows(),iv->cols());
5524    return TRUE;
5525  }
5526  res->data=u->data; u->data=NULL;
5527  res->rtyp=u->rtyp; u->rtyp=0;
5528  res->name=u->name; u->name=NULL;
5529  Subexpr e=jjMakeSub(v);
5530          e->next=jjMakeSub(w);
5531  if (u->e==NULL) res->e=e;
5532  else
5533  {
5534    Subexpr h=u->e;
5535    while (h->next!=NULL) h=h->next;
5536    h->next=e;
5537    res->e=u->e;
5538    u->e=NULL;
5539  }
5540  return FALSE;
5541}
5542static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5543{
5544  bigintmat *bim = (bigintmat *)u->Data();
5545  int   r = (int)(long)v->Data();
5546  int   c = (int)(long)w->Data();
5547  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5548  {
5549    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5550           r,c,u->Fullname(),bim->rows(),bim->cols());
5551    return TRUE;
5552  }
5553  res->data=u->data; u->data=NULL;
5554  res->rtyp=u->rtyp; u->rtyp=0;
5555  res->name=u->name; u->name=NULL;
5556  Subexpr e=jjMakeSub(v);
5557          e->next=jjMakeSub(w);
5558  if (u->e==NULL)
5559    res->e=e;
5560  else
5561  {
5562    Subexpr h=u->e;
5563    while (h->next!=NULL) h=h->next;
5564    h->next=e;
5565    res->e=u->e;
5566    u->e=NULL;
5567  }
5568  return FALSE;
5569}
5570static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5571{
5572  matrix m= (matrix)u->Data();
5573  int   r = (int)(long)v->Data();
5574  int   c = (int)(long)w->Data();
5575  //Print("gen. elem %d, %d\n",r,c);
5576  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5577  {
5578    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5579      MATROWS(m),MATCOLS(m));
5580    return TRUE;
5581  }
5582  res->data=u->data; u->data=NULL;
5583  res->rtyp=u->rtyp; u->rtyp=0;
5584  res->name=u->name; u->name=NULL;
5585  Subexpr e=jjMakeSub(v);
5586          e->next=jjMakeSub(w);
5587  if (u->e==NULL)
5588    res->e=e;
5589  else
5590  {
5591    Subexpr h=u->e;
5592    while (h->next!=NULL) h=h->next;
5593    h->next=e;
5594    res->e=u->e;
5595    u->e=NULL;
5596  }
5597  return FALSE;
5598}
5599static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5600{
5601  sleftv t;
5602  sleftv ut;
5603  leftv p=NULL;
5604  intvec *iv=(intvec *)w->Data();
5605  int l;
5606  BOOLEAN nok;
5607
5608  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5609  {
5610    WerrorS("cannot build expression lists from unnamed objects");
5611    return TRUE;
5612  }
5613  memcpy(&ut,u,sizeof(ut));
5614  memset(&t,0,sizeof(t));
5615  t.rtyp=INT_CMD;
5616  for (l=0;l< iv->length(); l++)
5617  {
5618    t.data=(char *)(long)((*iv)[l]);
5619    if (p==NULL)
5620    {
5621      p=res;
5622    }
5623    else
5624    {
5625      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5626      p=p->next;
5627    }
5628    memcpy(u,&ut,sizeof(ut));
5629    if (u->Typ() == MATRIX_CMD)
5630      nok=jjBRACK_Ma(p,u,v,&t);
5631    else /* INTMAT_CMD */
5632      nok=jjBRACK_Im(p,u,v,&t);
5633    if (nok)
5634    {
5635      while (res->next!=NULL)
5636      {
5637        p=res->next->next;
5638        omFreeBin((ADDRESS)res->next, sleftv_bin);
5639        // res->e aufraeumen !!!!
5640        res->next=p;
5641      }
5642      return TRUE;
5643    }
5644  }
5645  return FALSE;
5646}
5647static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5648{
5649  sleftv t;
5650  sleftv ut;
5651  leftv p=NULL;
5652  intvec *iv=(intvec *)v->Data();
5653  int l;
5654  BOOLEAN nok;
5655
5656  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5657  {
5658    WerrorS("cannot build expression lists from unnamed objects");
5659    return TRUE;
5660  }
5661  memcpy(&ut,u,sizeof(ut));
5662  memset(&t,0,sizeof(t));
5663  t.rtyp=INT_CMD;
5664  for (l=0;l< iv->length(); l++)
5665  {
5666    t.data=(char *)(long)((*iv)[l]);
5667    if (p==NULL)
5668    {
5669      p=res;
5670    }
5671    else
5672    {
5673      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5674      p=p->next;
5675    }
5676    memcpy(u,&ut,sizeof(ut));
5677    if (u->Typ() == MATRIX_CMD)
5678      nok=jjBRACK_Ma(p,u,&t,w);
5679    else /* INTMAT_CMD */
5680      nok=jjBRACK_Im(p,u,&t,w);
5681    if (nok)
5682    {
5683      while (res->next!=NULL)
5684      {
5685        p=res->next->next;
5686        omFreeBin((ADDRESS)res->next, sleftv_bin);
5687        // res->e aufraeumen !!
5688        res->next=p;
5689      }
5690      return TRUE;
5691    }
5692  }
5693  return FALSE;
5694}
5695static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5696{
5697  sleftv t1,t2,ut;
5698  leftv p=NULL;
5699  intvec *vv=(intvec *)v->Data();
5700  intvec *wv=(intvec *)w->Data();
5701  int vl;
5702  int wl;
5703  BOOLEAN nok;
5704
5705  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5706  {
5707    WerrorS("cannot build expression lists from unnamed objects");
5708    return TRUE;
5709  }
5710  memcpy(&ut,u,sizeof(ut));
5711  memset(&t1,0,sizeof(sleftv));
5712  memset(&t2,0,sizeof(sleftv));
5713  t1.rtyp=INT_CMD;
5714  t2.rtyp=INT_CMD;
5715  for (vl=0;vl< vv->length(); vl++)
5716  {
5717    t1.data=(char *)(long)((*vv)[vl]);
5718    for (wl=0;wl< wv->length(); wl++)
5719    {
5720      t2.data=(char *)(long)((*wv)[wl]);
5721      if (p==NULL)
5722      {
5723        p=res;
5724      }
5725      else
5726      {
5727        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5728        p=p->next;
5729      }
5730      memcpy(u,&ut,sizeof(ut));
5731      if (u->Typ() == MATRIX_CMD)
5732        nok=jjBRACK_Ma(p,u,&t1,&t2);
5733      else /* INTMAT_CMD */
5734        nok=jjBRACK_Im(p,u,&t1,&t2);
5735      if (nok)
5736      {
5737        res->CleanUp();
5738        return TRUE;
5739      }
5740    }
5741  }
5742  return FALSE;
5743}
5744static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5745{
5746  v->next=(leftv)omAllocBin(sleftv_bin);
5747  memcpy(v->next,w,sizeof(sleftv));
5748  memset(w,0,sizeof(sleftv));
5749  return jjPROC(res,u,v);
5750}
5751static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5752{
5753  intvec *iv;
5754  ideal m;
5755  lists l=(lists)omAllocBin(slists_bin);
5756  int k=(int)(long)w->Data();
5757  if (k>=0)
5758  {
5759    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5760    l->Init(2);
5761    l->m[0].rtyp=MODUL_CMD;
5762    l->m[1].rtyp=INTVEC_CMD;
5763    l->m[0].data=(void *)m;
5764    l->m[1].data=(void *)iv;
5765  }
5766  else
5767  {
5768    m=sm_CallSolv((ideal)u->Data(), currRing);
5769    l->Init(1);
5770    l->m[0].rtyp=IDEAL_CMD;
5771    l->m[0].data=(void *)m;
5772  }
5773  res->data = (char *)l;
5774  return FALSE;
5775}
5776static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5777{
5778  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5779  {
5780    WerrorS("3rd argument must be a name of a matrix");
5781    return TRUE;
5782  }
5783  ideal i=(ideal)u->Data();
5784  int rank=(int)i->rank;
5785  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5786  if (r) return TRUE;
5787  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5788