source: git/Singular/iparith.cc @ f8565a

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