source: git/Singular/iparith.cc @ 1daf0d

spielwiese
Last change on this file since 1daf0d was de27d8, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: intdiv/intmod/chinrem copied from master
  • Property mode set to 100644
File size: 218.0 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/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 <polys/clapsing.h>
66#  include <kernel/kstdfac.h>
67#endif /* HAVE_FACTORY */
68#ifdef HAVE_FACTORY
69#  include <kernel/fglm.h>
70#  include <Singular/fglm.h>
71#endif /* HAVE_FACTORY */
72#include <Singular/interpolation.h>
73
74#include <Singular/blackbox.h>
75#include <Singular/newstruct.h>
76#include <Singular/ipshell.h>
77//#include <kernel/mpr_inout.h>
78
79#include <kernel/timer.h>
80
81#include <polys/coeffrings.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)pDegW(I->m[i],iv));
1898  omFreeSize((ADDRESS)iv,(currRing->N+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    int d=(int)pDegW(p,iv);
1909    omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1910    res->data = (char *)(long(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  number a=(number) u->Data();
2354  number b=(number) v->Data();
2355  if (n_IsZero(a,coeffs_BIGINT))
2356  {
2357    if (n_IsZero(b,coeffs_BIGINT)) res->data=(char *)n_Init(1,coeffs_BIGINT);
2358    else                           res->data=(char *)n_Copy(b,coeffs_BIGINT);
2359  }
2360  else
2361  {
2362    if (n_IsZero(b,coeffs_BIGINT))  res->data=(char *)n_Copy(a,coeffs_BIGINT);
2363    else res->data=(char *)n_Gcd(a, b, coeffs_BIGINT);
2364  }
2365  return FALSE;
2366}
2367static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2368{
2369  number a=(number) u->Data();
2370  number b=(number) v->Data();
2371  if (nIsZero(a))
2372  {
2373    if (nIsZero(b)) res->data=(char *)nInit(1);
2374    else            res->data=(char *)nCopy(b);
2375  }
2376  else
2377  {
2378    if (nIsZero(b))  res->data=(char *)nCopy(a);
2379    else res->data=(char *)nGcd(a, b, currRing);
2380  }
2381  return FALSE;
2382}
2383#ifdef HAVE_FACTORY
2384static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2385{
2386  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2387                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2388  return FALSE;
2389}
2390#endif /* HAVE_FACTORY */
2391static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2392{
2393#ifdef HAVE_RINGS
2394  if (rField_is_Ring_Z(currRing))
2395  {
2396    ring origR = currRing;
2397    ring tempR = rCopy(origR);
2398    coeffs new_cf=nInitChar(n_Q,NULL);
2399    nKillChar(tempR->cf);
2400    tempR->cf=new_cf;
2401    rComplete(tempR);
2402    ideal uid = (ideal)u->Data();
2403    rChangeCurrRing(tempR);
2404    ideal uu = idrCopyR(uid, origR, currRing);
2405    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2406    uuAsLeftv.rtyp = IDEAL_CMD;
2407    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2408    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2409    assumeStdFlag(&uuAsLeftv);
2410    Print("// NOTE: computation of Hilbert series etc. is being\n");
2411    Print("//       performed for generic fibre, that is, over Q\n");
2412    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2413    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2414    int returnWithTrue = 1;
2415    switch((int)(long)v->Data())
2416    {
2417      case 1:
2418        res->data=(void *)iv;
2419        returnWithTrue = 0;
2420      case 2:
2421        res->data=(void *)hSecondSeries(iv);
2422        delete iv;
2423        returnWithTrue = 0;
2424    }
2425    if (returnWithTrue)
2426    {
2427      WerrorS(feNotImplemented);
2428      delete iv;
2429    }
2430    idDelete(&uu);
2431    rChangeCurrRing(origR);
2432    rDelete(tempR);
2433    if (returnWithTrue) return TRUE; else return FALSE;
2434  }
2435#endif
2436  assumeStdFlag(u);
2437  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2438  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2439  switch((int)(long)v->Data())
2440  {
2441    case 1:
2442      res->data=(void *)iv;
2443      return FALSE;
2444    case 2:
2445      res->data=(void *)hSecondSeries(iv);
2446      delete iv;
2447      return FALSE;
2448  }
2449  WerrorS(feNotImplemented);
2450  delete iv;
2451  return TRUE;
2452}
2453static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2454{
2455  int i=pVar((poly)v->Data());
2456  if (i==0)
2457  {
2458    WerrorS("ringvar expected");
2459    return TRUE;
2460  }
2461  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2462  int d=pWTotaldegree(p);
2463  pLmDelete(p);
2464  if (d==1)
2465    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2466  else
2467    WerrorS("variable must have weight 1");
2468  return (d!=1);
2469}
2470static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2471{
2472  int i=pVar((poly)v->Data());
2473  if (i==0)
2474  {
2475    WerrorS("ringvar expected");
2476    return TRUE;
2477  }
2478  pFDegProc deg;
2479  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2480    deg=p_Totaldegree;
2481   else
2482    deg=currRing->pFDeg;
2483  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2484  int d=deg(p,currRing);
2485  pLmDelete(p);
2486  if (d==1)
2487    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2488  else
2489    WerrorS("variable must have weight 1");
2490  return (d!=1);
2491}
2492static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2493{
2494  intvec *w=new intvec(rVar(currRing));
2495  intvec *vw=(intvec*)u->Data();
2496  ideal v_id=(ideal)v->Data();
2497  pFDegProc save_FDeg=currRing->pFDeg;
2498  pLDegProc save_LDeg=currRing->pLDeg;
2499  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2500  currRing->pLexOrder=FALSE;
2501  kHomW=vw;
2502  kModW=w;
2503  pSetDegProcs(currRing,kHomModDeg);
2504  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2505  currRing->pLexOrder=save_pLexOrder;
2506  kHomW=NULL;
2507  kModW=NULL;
2508  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2509  if (w!=NULL) delete w;
2510  return FALSE;
2511}
2512static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2513{
2514  assumeStdFlag(u);
2515  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2516                    currQuotient);
2517  return FALSE;
2518}
2519static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2520{
2521  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2522  setFlag(res,FLAG_STD);
2523  return FALSE;
2524}
2525static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2526{
2527  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2528}
2529static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2530{
2531  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2532  return FALSE;
2533}
2534static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2535{
2536  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2537  return FALSE;
2538}
2539static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2540{
2541  assumeStdFlag(u);
2542  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2543  res->data = (char *)scKBase((int)(long)v->Data(),
2544                              (ideal)(u->Data()),currQuotient, w_u);
2545  if (w_u!=NULL)
2546  {
2547    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2548  }
2549  return FALSE;
2550}
2551static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2552static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2553{
2554  return jjPREIMAGE(res,u,v,NULL);
2555}
2556static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2557{
2558  return mpKoszul(res, u,v,NULL);
2559}
2560static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2561{
2562  sleftv h;
2563  memset(&h,0,sizeof(sleftv));
2564  h.rtyp=INT_CMD;
2565  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2566  return mpKoszul(res, u, &h, v);
2567}
2568static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2569{
2570  int ul= IDELEMS((ideal)u->Data());
2571  int vl= IDELEMS((ideal)v->Data());
2572  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2573                   hasFlag(u,FLAG_STD));
2574  if (m==NULL) return TRUE;
2575  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2576  return FALSE;
2577}
2578static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2579{
2580  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2581  idhdl h=(idhdl)v->data;
2582  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2583  res->data = (char *)idLiftStd((ideal)u->Data(),
2584                                &(h->data.umatrix),testHomog);
2585  setFlag(res,FLAG_STD); v->flag=0;
2586  return FALSE;
2587}
2588static BOOLEAN jjLOAD2(leftv res, leftv, leftv v)
2589{
2590  return jjLOAD((char*)v->Data(),TRUE);
2591}
2592static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2593{
2594  char * s=(char *)u->Data();
2595  if(strcmp(s, "with")==0)
2596    return jjLOAD((char*)v->Data(), TRUE);
2597  WerrorS("invalid second argument");
2598  WerrorS("load(\"libname\" [,\"with\"]);");
2599  return TRUE;
2600}
2601static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2602{
2603  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2604  tHomog hom=testHomog;
2605  if (w_u!=NULL)
2606  {
2607    w_u=ivCopy(w_u);
2608    hom=isHomog;
2609  }
2610  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2611  if (w_v!=NULL)
2612  {
2613    w_v=ivCopy(w_v);
2614    hom=isHomog;
2615  }
2616  if ((w_u!=NULL) && (w_v==NULL))
2617    w_v=ivCopy(w_u);
2618  if ((w_v!=NULL) && (w_u==NULL))
2619    w_u=ivCopy(w_v);
2620  ideal u_id=(ideal)u->Data();
2621  ideal v_id=(ideal)v->Data();
2622  if (w_u!=NULL)
2623  {
2624     if ((*w_u).compare((w_v))!=0)
2625     {
2626       WarnS("incompatible weights");
2627       delete w_u; w_u=NULL;
2628       hom=testHomog;
2629     }
2630     else
2631     {
2632       if ((!idTestHomModule(u_id,currQuotient,w_v))
2633       || (!idTestHomModule(v_id,currQuotient,w_v)))
2634       {
2635         WarnS("wrong weights");
2636         delete w_u; w_u=NULL;
2637         hom=testHomog;
2638       }
2639     }
2640  }
2641  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2642  if (w_u!=NULL)
2643  {
2644    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2645  }
2646  delete w_v;
2647  return FALSE;
2648}
2649static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2650{
2651  number q=(number)v->Data();
2652  if (n_IsZero(q,coeffs_BIGINT))
2653  {
2654    WerrorS(ii_div_by_0);
2655    return TRUE;
2656  }
2657  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2658  return FALSE;
2659}
2660static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2661{
2662  number q=(number)v->Data();
2663  if (nIsZero(q))
2664  {
2665    WerrorS(ii_div_by_0);
2666    return TRUE;
2667  }
2668  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2669  return FALSE;
2670}
2671static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2672static BOOLEAN jjMONITOR1(leftv res, leftv v)
2673{
2674  return jjMONITOR2(res,v,NULL);
2675}
2676static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2677{
2678#if 0
2679  char *opt=(char *)v->Data();
2680  int mode=0;
2681  while(*opt!='\0')
2682  {
2683    if (*opt=='i') mode |= PROT_I;
2684    else if (*opt=='o') mode |= PROT_O;
2685    opt++;
2686  }
2687  monitor((char *)(u->Data()),mode);
2688#else
2689  si_link l=(si_link)u->Data();
2690  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2691  if(strcmp(l->m->type,"ASCII")!=0)
2692  {
2693    Werror("ASCII link required, not `%s`",l->m->type);
2694    slClose(l);
2695    return TRUE;
2696  }
2697  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2698  if ( l->name[0]!='\0') // "" is the stop condition
2699  {
2700    const char *opt;
2701    int mode=0;
2702    if (v==NULL) opt=(const char*)"i";
2703    else         opt=(const char *)v->Data();
2704    while(*opt!='\0')
2705    {
2706      if (*opt=='i') mode |= PROT_I;
2707      else if (*opt=='o') mode |= PROT_O;
2708      opt++;
2709    }
2710    monitor((FILE *)l->data,mode);
2711  }
2712  else
2713    monitor(NULL,0);
2714  return FALSE;
2715#endif
2716}
2717static BOOLEAN jjMONOM(leftv res, leftv v)
2718{
2719  intvec *iv=(intvec *)v->Data();
2720  poly p=pOne();
2721  int i,e;
2722  BOOLEAN err=FALSE;
2723  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2724  {
2725    e=(*iv)[i-1];
2726    if (e>=0) pSetExp(p,i,e);
2727    else err=TRUE;
2728  }
2729  if (iv->length()==(currRing->N+1))
2730  {
2731    res->rtyp=VECTOR_CMD;
2732    e=(*iv)[currRing->N];
2733    if (e>=0) pSetComp(p,e);
2734    else err=TRUE;
2735  }
2736  pSetm(p);
2737  res->data=(char*)p;
2738  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2739  return err;
2740}
2741static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2742{
2743  // u: the name of the new type
2744  // v: the elements
2745  newstruct_desc d=newstructFromString((const char *)v->Data());
2746  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2747  return d==NULL;
2748}
2749static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2750{
2751  idhdl h=(idhdl)u->data;
2752  int i=(int)(long)v->Data();
2753  int p=0;
2754  if ((0<i)
2755  && (rParameter(IDRING(h))!=NULL)
2756  && (i<=(p=rPar(IDRING(h)))))
2757    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2758  else
2759  {
2760    Werror("par number %d out of range 1..%d",i,p);
2761    return TRUE;
2762  }
2763  return FALSE;
2764}
2765#ifdef HAVE_PLURAL
2766static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2767{
2768  if( currRing->qideal != NULL )
2769  {
2770    WerrorS("basering must NOT be a qring!");
2771    return TRUE;
2772  }
2773
2774  if (iiOp==NCALGEBRA_CMD)
2775  {
2776    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2777  }
2778  else
2779  {
2780    ring r=rCopy(currRing);
2781    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2782    res->data=r;
2783    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2784    return result;
2785  }
2786}
2787static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2788{
2789  if( currRing->qideal != NULL )
2790  {
2791    WerrorS("basering must NOT be a qring!");
2792    return TRUE;
2793  }
2794
2795  if (iiOp==NCALGEBRA_CMD)
2796  {
2797    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2798  }
2799  else
2800  {
2801    ring r=rCopy(currRing);
2802    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2803    res->data=r;
2804    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2805    return result;
2806  }
2807}
2808static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2809{
2810  if( currRing->qideal != NULL )
2811  {
2812    WerrorS("basering must NOT be a qring!");
2813    return TRUE;
2814  }
2815
2816  if (iiOp==NCALGEBRA_CMD)
2817  {
2818    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2819  }
2820  else
2821  {
2822    ring r=rCopy(currRing);
2823    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2824    res->data=r;
2825    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2826    return result;
2827  }
2828}
2829static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2830{
2831  if( currRing->qideal != NULL )
2832  {
2833    WerrorS("basering must NOT be a qring!");
2834    return TRUE;
2835  }
2836
2837  if (iiOp==NCALGEBRA_CMD)
2838  {
2839    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2840  }
2841  else
2842  {
2843    ring r=rCopy(currRing);
2844    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2845    res->data=r;
2846    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2847    return result;
2848  }
2849}
2850static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2851{
2852  res->data=NULL;
2853
2854  if (rIsPluralRing(currRing))
2855  {
2856    const poly q = (poly)b->Data();
2857
2858    if( q != NULL )
2859    {
2860      if( (poly)a->Data() != NULL )
2861      {
2862        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2863        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2864      }
2865    }
2866  }
2867  return FALSE;
2868}
2869static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2870{
2871  /* number, poly, vector, ideal, module, matrix */
2872  ring  r = (ring)a->Data();
2873  if (r == currRing)
2874  {
2875    res->data = b->Data();
2876    res->rtyp = b->rtyp;
2877    return FALSE;
2878  }
2879  if (!rIsLikeOpposite(currRing, r))
2880  {
2881    Werror("%s is not an opposite ring to current ring",a->Fullname());
2882    return TRUE;
2883  }
2884  idhdl w;
2885  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2886  {
2887    int argtype = IDTYP(w);
2888    switch (argtype)
2889    {
2890    case NUMBER_CMD:
2891      {
2892        /* since basefields are equal, we can apply nCopy */
2893        res->data = nCopy((number)IDDATA(w));
2894        res->rtyp = argtype;
2895        break;
2896      }
2897    case POLY_CMD:
2898    case VECTOR_CMD:
2899      {
2900        poly    q = (poly)IDDATA(w);
2901        res->data = pOppose(r,q,currRing);
2902        res->rtyp = argtype;
2903        break;
2904      }
2905    case IDEAL_CMD:
2906    case MODUL_CMD:
2907      {
2908        ideal   Q = (ideal)IDDATA(w);
2909        res->data = idOppose(r,Q,currRing);
2910        res->rtyp = argtype;
2911        break;
2912      }
2913    case MATRIX_CMD:
2914      {
2915        ring save = currRing;
2916        rChangeCurrRing(r);
2917        matrix  m = (matrix)IDDATA(w);
2918        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2919        rChangeCurrRing(save);
2920        ideal   S = idOppose(r,Q,currRing);
2921        id_Delete(&Q, r);
2922        res->data = id_Module2Matrix(S,currRing);
2923        res->rtyp = argtype;
2924        break;
2925      }
2926    default:
2927      {
2928        WerrorS("unsupported type in oppose");
2929        return TRUE;
2930      }
2931    }
2932  }
2933  else
2934  {
2935    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2936    return TRUE;
2937  }
2938  return FALSE;
2939}
2940#endif /* HAVE_PLURAL */
2941
2942static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2943{
2944  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2945    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2946  id_DelMultiples((ideal)(res->data),currRing);
2947  return FALSE;
2948}
2949static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2950{
2951  int i=(int)(long)u->Data();
2952  int j=(int)(long)v->Data();
2953  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2954  return FALSE;
2955}
2956static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2957{
2958  matrix m =(matrix)u->Data();
2959  int isRowEchelon = (int)(long)v->Data();
2960  if (isRowEchelon != 1) isRowEchelon = 0;
2961  int rank = luRank(m, isRowEchelon);
2962  res->data =(char *)(long)rank;
2963  return FALSE;
2964}
2965static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2966{
2967  si_link l=(si_link)u->Data();
2968  leftv r=slRead(l,v);
2969  if (r==NULL)
2970  {
2971    const char *s;
2972    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2973    else                            s=sNoName;
2974    Werror("cannot read from `%s`",s);
2975    return TRUE;
2976  }
2977  memcpy(res,r,sizeof(sleftv));
2978  omFreeBin((ADDRESS)r, sleftv_bin);
2979  return FALSE;
2980}
2981static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2982{
2983  assumeStdFlag(v);
2984  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2985  return FALSE;
2986}
2987static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2988{
2989  assumeStdFlag(v);
2990  ideal ui=(ideal)u->Data();
2991  ideal vi=(ideal)v->Data();
2992  res->data = (char *)kNF(vi,currQuotient,ui);
2993  return FALSE;
2994}
2995#if 0
2996static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2997{
2998  int maxl=(int)(long)v->Data();
2999  if (maxl<0)
3000  {
3001    WerrorS("length for res must not be negative");
3002    return TRUE;
3003  }
3004  int l=0;
3005  //resolvente r;
3006  syStrategy r;
3007  intvec *weights=NULL;
3008  int wmaxl=maxl;
3009  ideal u_id=(ideal)u->Data();
3010
3011  maxl--;
3012  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3013  {
3014    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3015    if (currQuotient!=NULL)
3016    {
3017      Warn(
3018      "full resolution in a qring may be infinite, setting max length to %d",
3019      maxl+1);
3020    }
3021  }
3022  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3023  if (weights!=NULL)
3024  {
3025    if (!idTestHomModule(u_id,currQuotient,weights))
3026    {
3027      WarnS("wrong weights given:");weights->show();PrintLn();
3028      weights=NULL;
3029    }
3030  }
3031  intvec *ww=NULL;
3032  int add_row_shift=0;
3033  if (weights!=NULL)
3034  {
3035     ww=ivCopy(weights);
3036     add_row_shift = ww->min_in();
3037     (*ww) -= add_row_shift;
3038  }
3039  else
3040    idHomModule(u_id,currQuotient,&ww);
3041  weights=ww;
3042
3043  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3044  {
3045    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3046  }
3047  else if (iiOp==SRES_CMD)
3048  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3049    r=sySchreyer(u_id,maxl+1);
3050  else if (iiOp == LRES_CMD)
3051  {
3052    int dummy;
3053    if((currQuotient!=NULL)||
3054    (!idHomIdeal (u_id,NULL)))
3055    {
3056       WerrorS
3057       ("`lres` not implemented for inhomogeneous input or qring");
3058       return TRUE;
3059    }
3060    r=syLaScala3(u_id,&dummy);
3061  }
3062  else if (iiOp == KRES_CMD)
3063  {
3064    int dummy;
3065    if((currQuotient!=NULL)||
3066    (!idHomIdeal (u_id,NULL)))
3067    {
3068       WerrorS
3069       ("`kres` not implemented for inhomogeneous input or qring");
3070       return TRUE;
3071    }
3072    r=syKosz(u_id,&dummy);
3073  }
3074  else
3075  {
3076    int dummy;
3077    if((currQuotient!=NULL)||
3078    (!idHomIdeal (u_id,NULL)))
3079    {
3080       WerrorS
3081       ("`hres` not implemented for inhomogeneous input or qring");
3082       return TRUE;
3083    }
3084    r=syHilb(u_id,&dummy);
3085  }
3086  if (r==NULL) return TRUE;
3087  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3088  r->list_length=wmaxl;
3089  res->data=(void *)r;
3090  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3091  {
3092    intvec *w=ivCopy(r->weights[0]);
3093    if (weights!=NULL) (*w) += add_row_shift;
3094    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3095    w=NULL;
3096  }
3097  else
3098  {
3099//#if 0
3100// need to set weights for ALL components (sres)
3101    if (weights!=NULL)
3102    {
3103      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3104      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3105      (r->weights)[0] = ivCopy(weights);
3106    }
3107//#endif
3108  }
3109  if (ww!=NULL) { delete ww; ww=NULL; }
3110  return FALSE;
3111}
3112#else
3113static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3114{
3115  int maxl=(int)(long)v->Data();
3116  if (maxl<0)
3117  {
3118    WerrorS("length for res must not be negative");
3119    return TRUE;
3120  }
3121  syStrategy r;
3122  intvec *weights=NULL;
3123  int wmaxl=maxl;
3124  ideal u_id=(ideal)u->Data();
3125
3126  maxl--;
3127  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3128  {
3129    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3130    if (currQuotient!=NULL)
3131    {
3132      Warn(
3133      "full resolution in a qring may be infinite, setting max length to %d",
3134      maxl+1);
3135    }
3136  }
3137  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3138  if (weights!=NULL)
3139  {
3140    if (!idTestHomModule(u_id,currQuotient,weights))
3141    {
3142      WarnS("wrong weights given:");weights->show();PrintLn();
3143      weights=NULL;
3144    }
3145  }
3146  intvec *ww=NULL;
3147  int add_row_shift=0;
3148  if (weights!=NULL)
3149  {
3150     ww=ivCopy(weights);
3151     add_row_shift = ww->min_in();
3152     (*ww) -= add_row_shift;
3153  }
3154  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3155  {
3156    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3157  }
3158  else if (iiOp==SRES_CMD)
3159  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3160    r=sySchreyer(u_id,maxl+1);
3161  else if (iiOp == LRES_CMD)
3162  {
3163    int dummy;
3164    if((currQuotient!=NULL)||
3165    (!idHomIdeal (u_id,NULL)))
3166    {
3167       WerrorS
3168       ("`lres` not implemented for inhomogeneous input or qring");
3169       return TRUE;
3170    }
3171    if(currRing->N == 1)
3172      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3173    r=syLaScala3(u_id,&dummy);
3174  }
3175  else if (iiOp == KRES_CMD)
3176  {
3177    int dummy;
3178    if((currQuotient!=NULL)||
3179    (!idHomIdeal (u_id,NULL)))
3180    {
3181       WerrorS
3182       ("`kres` not implemented for inhomogeneous input or qring");
3183       return TRUE;
3184    }
3185    r=syKosz(u_id,&dummy);
3186  }
3187  else
3188  {
3189    int dummy;
3190    if((currQuotient!=NULL)||
3191    (!idHomIdeal (u_id,NULL)))
3192    {
3193       WerrorS
3194       ("`hres` not implemented for inhomogeneous input or qring");
3195       return TRUE;
3196    }
3197    ideal u_id_copy=idCopy(u_id);
3198    idSkipZeroes(u_id_copy);
3199    r=syHilb(u_id_copy,&dummy);
3200    idDelete(&u_id_copy);
3201  }
3202  if (r==NULL) return TRUE;
3203  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3204  r->list_length=wmaxl;
3205  res->data=(void *)r;
3206  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3207  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3208  {
3209    ww=ivCopy(r->weights[0]);
3210    if (weights!=NULL) (*ww) += add_row_shift;
3211    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3212  }
3213  else
3214  {
3215    if (weights!=NULL)
3216    {
3217      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3218    }
3219  }
3220
3221  // test the La Scala case' output
3222  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3223  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3224
3225  if(iiOp != HRES_CMD)
3226    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3227  else
3228    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3229
3230  return FALSE;
3231}
3232#endif
3233static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3234{
3235  number n1; int i;
3236
3237  if ((u->Typ() == BIGINT_CMD) ||
3238     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3239  {
3240    n1 = (number)u->CopyD();
3241  }
3242  else if (u->Typ() == INT_CMD)
3243  {
3244    i = (int)(long)u->Data();
3245    n1 = n_Init(i, coeffs_BIGINT);
3246  }
3247  else
3248  {
3249    return TRUE;
3250  }
3251
3252  i = (int)(long)v->Data();
3253
3254  lists l = primeFactorisation(n1, i);
3255  n_Delete(&n1, coeffs_BIGINT);
3256  res->data = (char*)l;
3257  return FALSE;
3258}
3259static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3260{
3261  ring r;
3262  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3263  res->data = (char *)r;
3264  return (i==-1);
3265}
3266#define SIMPL_LMDIV 32
3267#define SIMPL_LMEQ  16
3268#define SIMPL_MULT 8
3269#define SIMPL_EQU  4
3270#define SIMPL_NULL 2
3271#define SIMPL_NORM 1
3272static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3273{
3274  int sw = (int)(long)v->Data();
3275  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3276  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3277  if (sw & SIMPL_LMDIV)
3278  {
3279    id_DelDiv(id,currRing);
3280  }
3281  if (sw & SIMPL_LMEQ)
3282  {
3283    id_DelLmEquals(id,currRing);
3284  }
3285  if (sw & SIMPL_MULT)
3286  {
3287    id_DelMultiples(id,currRing);
3288  }
3289  else if(sw & SIMPL_EQU)
3290  {
3291    id_DelEquals(id,currRing);
3292  }
3293  if (sw & SIMPL_NULL)
3294  {
3295    idSkipZeroes(id);
3296  }
3297  if (sw & SIMPL_NORM)
3298  {
3299    id_Norm(id,currRing);
3300  }
3301  res->data = (char * )id;
3302  return FALSE;
3303}
3304#ifdef HAVE_FACTORY
3305extern int singclap_factorize_retry;
3306static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3307{
3308  intvec *v=NULL;
3309  int sw=(int)(long)dummy->Data();
3310  int fac_sw=sw;
3311  if (sw<0) fac_sw=1;
3312  singclap_factorize_retry=0;
3313  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3314  if (f==NULL)
3315    return TRUE;
3316  switch(sw)
3317  {
3318    case 0:
3319    case 2:
3320    {
3321      lists l=(lists)omAllocBin(slists_bin);
3322      l->Init(2);
3323      l->m[0].rtyp=IDEAL_CMD;
3324      l->m[0].data=(void *)f;
3325      l->m[1].rtyp=INTVEC_CMD;
3326      l->m[1].data=(void *)v;
3327      res->data=(void *)l;
3328      res->rtyp=LIST_CMD;
3329      return FALSE;
3330    }
3331    case 1:
3332      res->data=(void *)f;
3333      return FALSE;
3334    case 3:
3335      {
3336        poly p=f->m[0];
3337        int i=IDELEMS(f);
3338        f->m[0]=NULL;
3339        while(i>1)
3340        {
3341          i--;
3342          p=pMult(p,f->m[i]);
3343          f->m[i]=NULL;
3344        }
3345        res->data=(void *)p;
3346        res->rtyp=POLY_CMD;
3347      }
3348      return FALSE;
3349  }
3350  WerrorS("invalid switch");
3351  return FALSE;
3352}
3353#endif
3354static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3355{
3356  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3357  return FALSE;
3358}
3359static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3360{
3361  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3362  //return (res->data== (void*)(long)-2);
3363  return FALSE;
3364}
3365static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3366{
3367  int sw = (int)(long)v->Data();
3368  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3369  poly p = (poly)u->CopyD(POLY_CMD);
3370  if (sw & SIMPL_NORM)
3371  {
3372    pNorm(p);
3373  }
3374  res->data = (char * )p;
3375  return FALSE;
3376}
3377static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3378{
3379  ideal result;
3380  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3381  tHomog hom=testHomog;
3382  ideal u_id=(ideal)(u->Data());
3383  if (w!=NULL)
3384  {
3385    if (!idTestHomModule(u_id,currQuotient,w))
3386    {
3387      WarnS("wrong weights:");w->show();PrintLn();
3388      w=NULL;
3389    }
3390    else
3391    {
3392      w=ivCopy(w);
3393      hom=isHomog;
3394    }
3395  }
3396  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3397  idSkipZeroes(result);
3398  res->data = (char *)result;
3399  setFlag(res,FLAG_STD);
3400  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3401  return FALSE;
3402}
3403static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3404static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3405/* destroys i0, p0 */
3406/* result (with attributes) in res */
3407/* i0: SB*/
3408/* t0: type of p0*/
3409/* p0 new elements*/
3410/* a attributes of i0*/
3411{
3412  int tp;
3413  if (t0==IDEAL_CMD) tp=POLY_CMD;
3414  else               tp=VECTOR_CMD;
3415  for (int i=IDELEMS(p0)-1; i>=0; i--)
3416  {
3417    poly p=p0->m[i];
3418    p0->m[i]=NULL;
3419    if (p!=NULL)
3420    {
3421      sleftv u0,v0;
3422      memset(&u0,0,sizeof(sleftv));
3423      memset(&v0,0,sizeof(sleftv));
3424      v0.rtyp=tp;
3425      v0.data=(void*)p;
3426      u0.rtyp=t0;
3427      u0.data=i0;
3428      u0.attribute=a;
3429      setFlag(&u0,FLAG_STD);
3430      jjSTD_1(res,&u0,&v0);
3431      i0=(ideal)res->data;
3432      res->data=NULL;
3433      a=res->attribute;
3434      res->attribute=NULL;
3435      u0.CleanUp();
3436      v0.CleanUp();
3437      res->CleanUp();
3438    }
3439  }
3440  idDelete(&p0);
3441  res->attribute=a;
3442  res->data=(void *)i0;
3443  res->rtyp=t0;
3444}
3445static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3446{
3447  ideal result;
3448  assumeStdFlag(u);
3449  ideal i1=(ideal)(u->Data());
3450  ideal i0;
3451  int r=v->Typ();
3452  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3453  {
3454    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3455    i0->m[0]=(poly)v->Data();
3456    int ii0=idElem(i0); /* size of i0 */
3457    i1=idSimpleAdd(i1,i0); //
3458    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3459    idDelete(&i0);
3460    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3461    tHomog hom=testHomog;
3462
3463    if (w!=NULL)
3464    {
3465      if (!idTestHomModule(i1,currQuotient,w))
3466      {
3467        // no warnung: this is legal, if i in std(i,p)
3468        // is homogeneous, but p not
3469        w=NULL;
3470      }
3471      else
3472      {
3473        w=ivCopy(w);
3474        hom=isHomog;
3475      }
3476    }
3477    BITSET save1;
3478    SI_SAVE_OPT1(save1);
3479    si_opt_1|=Sy_bit(OPT_SB_1);
3480    /* ii0 appears to be the position of the first element of il that
3481       does not belong to the old SB ideal */
3482    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3483    SI_RESTORE_OPT1(save1);
3484    idDelete(&i1);
3485    idSkipZeroes(result);
3486    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3487    res->data = (char *)result;
3488  }
3489  else /*IDEAL/MODULE*/
3490  {
3491    attr *aa=u->Attribute();
3492    attr a=NULL;
3493    if (aa!=NULL) a=(*aa)->Copy();
3494    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3495  }
3496  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3497  return FALSE;
3498}
3499static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3500{
3501  idhdl h=(idhdl)u->data;
3502  int i=(int)(long)v->Data();
3503  if ((0<i) && (i<=IDRING(h)->N))
3504    res->data=omStrDup(IDRING(h)->names[i-1]);
3505  else
3506  {
3507    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3508    return TRUE;
3509  }
3510  return FALSE;
3511}
3512static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3513{
3514// input: u: a list with links of type
3515//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3516//        v: timeout for select in milliseconds
3517//           or 0 for polling
3518// returns: ERROR (via Werror): timeout negative
3519//           -1: the read state of all links is eof
3520//            0: timeout (or polling): none ready
3521//           i>0: (at least) L[i] is ready
3522  lists Lforks = (lists)u->Data();
3523  int t = (int)(long)v->Data();
3524  if(t < 0)
3525  {
3526    WerrorS("negative timeout"); return TRUE;
3527  }
3528  int i = slStatusSsiL(Lforks, t*1000);
3529  if(i == -2) /* error */
3530  {
3531    return TRUE;
3532  }
3533  res->data = (void*)(long)i;
3534  return FALSE;
3535}
3536static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3537{
3538// input: u: a list with links of type
3539//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3540//        v: timeout for select in milliseconds
3541//           or 0 for polling
3542// returns: ERROR (via Werror): timeout negative
3543//           -1: the read state of all links is eof
3544//           0: timeout (or polling): none ready
3545//           1: all links are ready
3546//              (caution: at least one is ready, but some maybe dead)
3547  lists Lforks = (lists)u->CopyD();
3548  int timeout = 1000*(int)(long)v->Data();
3549  if(timeout < 0)
3550  {
3551    WerrorS("negative timeout"); return TRUE;
3552  }
3553  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3554  int i;
3555  int ret = -1;
3556  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3557  {
3558    i = slStatusSsiL(Lforks, timeout);
3559    if(i > 0) /* Lforks[i] is ready */
3560    {
3561      ret = 1;
3562      Lforks->m[i-1].CleanUp();
3563      Lforks->m[i-1].rtyp=DEF_CMD;
3564      Lforks->m[i-1].data=NULL;
3565      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3566    }
3567    else /* terminate the for loop */
3568    {
3569      if(i == -2) /* error */
3570      {
3571        return TRUE;
3572      }
3573      if(i == 0) /* timeout */
3574      {
3575        ret = 0;
3576      }
3577      break;
3578    }
3579  }
3580  Lforks->Clean();
3581  res->data = (void*)(long)ret;
3582  return FALSE;
3583}
3584static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3585{
3586  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3587  return FALSE;
3588}
3589#define jjWRONG2 (proc2)jjWRONG
3590#define jjWRONG3 (proc3)jjWRONG
3591static BOOLEAN jjWRONG(leftv, leftv)
3592{
3593  return TRUE;
3594}
3595
3596/*=================== operations with 1 arg.: static proc =================*/
3597/* must be ordered: first operations for chars (infix ops),
3598 * then alphabetically */
3599
3600static BOOLEAN jjDUMMY(leftv res, leftv u)
3601{
3602  res->data = (char *)u->CopyD();
3603  return FALSE;
3604}
3605static BOOLEAN jjNULL(leftv, leftv)
3606{
3607  return FALSE;
3608}
3609//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3610//{
3611//  res->data = (char *)((int)(long)u->Data()+1);
3612//  return FALSE;
3613//}
3614//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3615//{
3616//  res->data = (char *)((int)(long)u->Data()-1);
3617//  return FALSE;
3618//}
3619static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3620{
3621  if (IDTYP((idhdl)u->data)==INT_CMD)
3622  {
3623    int i=IDINT((idhdl)u->data);
3624    if (iiOp==PLUSPLUS) i++;
3625    else                i--;
3626    IDDATA((idhdl)u->data)=(char *)(long)i;
3627    return FALSE;
3628  }
3629  return TRUE;
3630}
3631static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3632{
3633  number n=(number)u->CopyD(BIGINT_CMD);
3634  n=n_Neg(n,coeffs_BIGINT);
3635  res->data = (char *)n;
3636  return FALSE;
3637}
3638static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3639{
3640  res->data = (char *)(-(long)u->Data());
3641  return FALSE;
3642}
3643static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3644{
3645  number n=(number)u->CopyD(NUMBER_CMD);
3646  n=nNeg(n);
3647  res->data = (char *)n;
3648  return FALSE;
3649}
3650static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3651{
3652  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3653  return FALSE;
3654}
3655static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3656{
3657  poly m1=pISet(-1);
3658  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3659  return FALSE;
3660}
3661static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3662{
3663  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3664  (*iv)*=(-1);
3665  res->data = (char *)iv;
3666  return FALSE;
3667}
3668static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3669{
3670  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3671  (*bim)*=(-1);
3672  res->data = (char *)bim;
3673  return FALSE;
3674}
3675static BOOLEAN jjPROC1(leftv res, leftv u)
3676{
3677  return jjPROC(res,u,NULL);
3678}
3679static BOOLEAN jjBAREISS(leftv res, leftv v)
3680{
3681  //matrix m=(matrix)v->Data();
3682  //lists l=mpBareiss(m,FALSE);
3683  intvec *iv;
3684  ideal m;
3685  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3686  lists l=(lists)omAllocBin(slists_bin);
3687  l->Init(2);
3688  l->m[0].rtyp=MODUL_CMD;
3689  l->m[1].rtyp=INTVEC_CMD;
3690  l->m[0].data=(void *)m;
3691  l->m[1].data=(void *)iv;
3692  res->data = (char *)l;
3693  return FALSE;
3694}
3695//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3696//{
3697//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3698//  ivTriangMat(m);
3699//  res->data = (char *)m;
3700//  return FALSE;
3701//}
3702static BOOLEAN jjBI2N(leftv res, leftv u)
3703{
3704  BOOLEAN bo=FALSE;
3705  number n=(number)u->CopyD();
3706  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3707  if (nMap!=NULL)
3708    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3709  else
3710  {
3711    WerrorS("cannot convert bigint to this field");
3712    bo=TRUE;
3713  }
3714  n_Delete(&n,coeffs_BIGINT);
3715  return bo;
3716}
3717static BOOLEAN jjBI2P(leftv res, leftv u)
3718{
3719  sleftv tmp;
3720  BOOLEAN bo=jjBI2N(&tmp,u);
3721  if (!bo)
3722  {
3723    number n=(number) tmp.data;
3724    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3725    else
3726    {
3727      res->data=(void *)pNSet(n);
3728    }
3729  }
3730  return bo;
3731}
3732static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3733{
3734  return iiExprArithM(res,u,iiOp);
3735}
3736static BOOLEAN jjCHAR(leftv res, leftv v)
3737{
3738  res->data = (char *)(long)rChar((ring)v->Data());
3739  return FALSE;
3740}
3741static BOOLEAN jjCOLS(leftv res, leftv v)
3742{
3743  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3744  return FALSE;
3745}
3746static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3747{
3748  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3749  return FALSE;
3750}
3751static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3752{
3753  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3754  return FALSE;
3755}
3756static BOOLEAN jjCONTENT(leftv res, leftv v)
3757{
3758  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3759  poly p=(poly)v->CopyD(POLY_CMD);
3760  if (p!=NULL) p_Cleardenom(p, currRing);
3761  res->data = (char *)p;
3762  return FALSE;
3763}
3764static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3765{
3766  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3767  return FALSE;
3768}
3769static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3770{
3771  res->data = (char *)(long)nSize((number)v->Data());
3772  return FALSE;
3773}
3774static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3775{
3776  lists l=(lists)v->Data();
3777  res->data = (char *)(long)(lSize(l)+1);
3778  return FALSE;
3779}
3780static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3781{
3782  matrix m=(matrix)v->Data();
3783  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3784  return FALSE;
3785}
3786static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3787{
3788  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3789  return FALSE;
3790}
3791static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3792{
3793  ring r=(ring)v->Data();
3794  int elems=-1;
3795  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3796  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3797  {
3798#ifdef HAVE_FACTORY
3799    extern int ipower ( int b, int n ); /* factory/cf_util */
3800    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3801#else
3802    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3803#endif
3804  }
3805  res->data = (char *)(long)elems;
3806  return FALSE;
3807}
3808static BOOLEAN jjDEG(leftv res, leftv v)
3809{
3810  int dummy;
3811  poly p=(poly)v->Data();
3812  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3813  else res->data=(char *)-1;
3814  return FALSE;
3815}
3816static BOOLEAN jjDEG_M(leftv res, leftv u)
3817{
3818  ideal I=(ideal)u->Data();
3819  int d=-1;
3820  int dummy;
3821  int i;
3822  for(i=IDELEMS(I)-1;i>=0;i--)
3823    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3824  res->data = (char *)(long)d;
3825  return FALSE;
3826}
3827static BOOLEAN jjDEGREE(leftv res, leftv v)
3828{
3829  SPrintStart();
3830#ifdef HAVE_RINGS
3831  if (rField_is_Ring_Z(currRing))
3832  {
3833    ring origR = currRing;
3834    ring tempR = rCopy(origR);
3835    coeffs new_cf=nInitChar(n_Q,NULL);
3836    nKillChar(tempR->cf);
3837    tempR->cf=new_cf;
3838    rComplete(tempR);
3839    ideal vid = (ideal)v->Data();
3840    rChangeCurrRing(tempR);
3841    ideal vv = idrCopyR(vid, origR, currRing);
3842    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3843    vvAsLeftv.rtyp = IDEAL_CMD;
3844    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3845    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3846    assumeStdFlag(&vvAsLeftv);
3847    Print("// NOTE: computation of degree is being performed for\n");
3848    Print("//       generic fibre, that is, over Q\n");
3849    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3850    scDegree(vv,module_w,currQuotient);
3851    idDelete(&vv);
3852    rChangeCurrRing(origR);
3853    rDelete(tempR);
3854  }
3855#endif
3856  assumeStdFlag(v);
3857  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3858  scDegree((ideal)v->Data(),module_w,currQuotient);
3859  char *s=SPrintEnd();
3860  int l=strlen(s)-1;
3861  s[l]='\0';
3862  res->data=(void*)s;
3863  return FALSE;
3864}
3865static BOOLEAN jjDEFINED(leftv res, leftv v)
3866{
3867  if ((v->rtyp==IDHDL)
3868  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3869  {
3870    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3871  }
3872  else if (v->rtyp!=0) res->data=(void *)(-1);
3873  return FALSE;
3874}
3875
3876/// Return the denominator of the input number
3877/// NOTE: the input number is normalized as a side effect
3878static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3879{
3880  number n = reinterpret_cast<number>(v->Data());
3881  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3882  return FALSE;
3883}
3884
3885/// Return the numerator of the input number
3886/// NOTE: the input number is normalized as a side effect
3887static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3888{
3889  number n = reinterpret_cast<number>(v->Data());
3890  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3891  return FALSE;
3892}
3893
3894
3895
3896
3897#ifdef HAVE_FACTORY
3898static BOOLEAN jjDET(leftv res, leftv v)
3899{
3900  matrix m=(matrix)v->Data();
3901  poly p;
3902  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3903  {
3904    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3905    p=sm_CallDet(I, currRing);
3906    idDelete(&I);
3907  }
3908  else
3909    p=singclap_det(m,currRing);
3910  res ->data = (char *)p;
3911  return FALSE;
3912}
3913static BOOLEAN jjDET_BI(leftv res, leftv v)
3914{
3915  bigintmat * m=(bigintmat*)v->Data();
3916  int i,j;
3917  i=m->rows();j=m->cols();
3918  if(i==j)
3919    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3920  else
3921  {
3922    Werror("det of %d x %d bigintmat",i,j);
3923    return TRUE;
3924  }
3925  return FALSE;
3926}
3927static BOOLEAN jjDET_I(leftv res, leftv v)
3928{
3929  intvec * m=(intvec*)v->Data();
3930  int i,j;
3931  i=m->rows();j=m->cols();
3932  if(i==j)
3933    res->data = (char *)(long)singclap_det_i(m,currRing);
3934  else
3935  {
3936    Werror("det of %d x %d intmat",i,j);
3937    return TRUE;
3938  }
3939  return FALSE;
3940}
3941static BOOLEAN jjDET_S(leftv res, leftv v)
3942{
3943  ideal I=(ideal)v->Data();
3944  poly p;
3945  if (IDELEMS(I)<1) return TRUE;
3946  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3947  {
3948    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3949    p=singclap_det(m,currRing);
3950    idDelete((ideal *)&m);
3951  }
3952  else
3953    p=sm_CallDet(I, currRing);
3954  res->data = (char *)p;
3955  return FALSE;
3956}
3957#endif
3958static BOOLEAN jjDIM(leftv res, leftv v)
3959{
3960  assumeStdFlag(v);
3961#ifdef HAVE_RINGS
3962  if (rField_is_Ring(currRing))
3963  {
3964    //ring origR = currRing;
3965    //ring tempR = rCopy(origR);
3966    //coeffs new_cf=nInitChar(n_Q,NULL);
3967    //nKillChar(tempR->cf);
3968    //tempR->cf=new_cf;
3969    //rComplete(tempR);
3970    ideal vid = (ideal)v->Data();
3971    int i = idPosConstant(vid);
3972    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3973    { /* ideal v contains unit; dim = -1 */
3974      res->data = (char *)-1;
3975      return FALSE;
3976    }
3977    //rChangeCurrRing(tempR);
3978    //ideal vv = idrCopyR(vid, origR, currRing);
3979    ideal vv = id_Head(vid,currRing);
3980    /* drop degree zero generator from vv (if any) */
3981    if (i != -1) pDelete(&vv->m[i]);
3982    long d = (long)scDimInt(vv, currQuotient);
3983    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3984    res->data = (char *)d;
3985    idDelete(&vv);
3986    //rChangeCurrRing(origR);
3987    //rDelete(tempR);
3988    return FALSE;
3989  }
3990#endif
3991  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3992  return FALSE;
3993}
3994static BOOLEAN jjDUMP(leftv, leftv v)
3995{
3996  si_link l = (si_link)v->Data();
3997  if (slDump(l))
3998  {
3999    const char *s;
4000    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4001    else                            s=sNoName;
4002    Werror("cannot dump to `%s`",s);
4003    return TRUE;
4004  }
4005  else
4006    return FALSE;
4007}
4008static BOOLEAN jjE(leftv res, leftv v)
4009{
4010  res->data = (char *)pOne();
4011  int co=(int)(long)v->Data();
4012  if (co>0)
4013  {
4014    pSetComp((poly)res->data,co);
4015    pSetm((poly)res->data);
4016  }
4017  else WerrorS("argument of gen must be positive");
4018  return (co<=0);
4019}
4020static BOOLEAN jjEXECUTE(leftv, leftv v)
4021{
4022  char * d = (char *)v->Data();
4023  char * s = (char *)omAlloc(strlen(d) + 13);
4024  strcpy( s, (char *)d);
4025  strcat( s, "\n;RETURN();\n");
4026  newBuffer(s,BT_execute);
4027  return yyparse();
4028}
4029#ifdef HAVE_FACTORY
4030static BOOLEAN jjFACSTD(leftv res, leftv v)
4031{
4032  lists L=(lists)omAllocBin(slists_bin);
4033  if (rField_is_Zp(currRing)
4034  || rField_is_Q(currRing)
4035  || rField_is_Zp_a(currRing)
4036  || rField_is_Q_a(currRing))
4037  {
4038    ideal_list p,h;
4039    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4040    if (h==NULL)
4041    {
4042      L->Init(1);
4043      L->m[0].data=(char *)idInit(1);
4044      L->m[0].rtyp=IDEAL_CMD;
4045    }
4046    else
4047    {
4048      p=h;
4049      int l=0;
4050      while (p!=NULL) { p=p->next;l++; }
4051      L->Init(l);
4052      l=0;
4053      while(h!=NULL)
4054      {
4055        L->m[l].data=(char *)h->d;
4056        L->m[l].rtyp=IDEAL_CMD;
4057        p=h->next;
4058        omFreeSize(h,sizeof(*h));
4059        h=p;
4060        l++;
4061      }
4062    }
4063  }
4064  else
4065  {
4066    WarnS("no factorization implemented");
4067    L->Init(1);
4068    iiExprArith1(&(L->m[0]),v,STD_CMD);
4069  }
4070  res->data=(void *)L;
4071  return FALSE;
4072}
4073static BOOLEAN jjFAC_P(leftv res, leftv u)
4074{
4075  intvec *v=NULL;
4076  singclap_factorize_retry=0;
4077  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4078  if (f==NULL) return TRUE;
4079  ivTest(v);
4080  lists l=(lists)omAllocBin(slists_bin);
4081  l->Init(2);
4082  l->m[0].rtyp=IDEAL_CMD;
4083  l->m[0].data=(void *)f;
4084  l->m[1].rtyp=INTVEC_CMD;
4085  l->m[1].data=(void *)v;
4086  res->data=(void *)l;
4087  return FALSE;
4088}
4089#endif
4090static BOOLEAN jjGETDUMP(leftv, leftv v)
4091{
4092  si_link l = (si_link)v->Data();
4093  if (slGetDump(l))
4094  {
4095    const char *s;
4096    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4097    else                            s=sNoName;
4098    Werror("cannot get dump from `%s`",s);
4099    return TRUE;
4100  }
4101  else
4102    return FALSE;
4103}
4104static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4105{
4106  assumeStdFlag(v);
4107  ideal I=(ideal)v->Data();
4108  res->data=(void *)iiHighCorner(I,0);
4109  return FALSE;
4110}
4111static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4112{
4113  assumeStdFlag(v);
4114  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4115  BOOLEAN delete_w=FALSE;
4116  ideal I=(ideal)v->Data();
4117  int i;
4118  poly p=NULL,po=NULL;
4119  int rk=id_RankFreeModule(I,currRing);
4120  if (w==NULL)
4121  {
4122    w = new intvec(rk);
4123    delete_w=TRUE;
4124  }
4125  for(i=rk;i>0;i--)
4126  {
4127    p=iiHighCorner(I,i);
4128    if (p==NULL)
4129    {
4130      WerrorS("module must be zero-dimensional");
4131      if (delete_w) delete w;
4132      return TRUE;
4133    }
4134    if (po==NULL)
4135    {
4136      po=p;
4137    }
4138    else
4139    {
4140      // now po!=NULL, p!=NULL
4141      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4142      if (d==0)
4143        d=pLmCmp(po,p);
4144      if (d > 0)
4145      {
4146        pDelete(&p);
4147      }
4148      else // (d < 0)
4149      {
4150        pDelete(&po); po=p;
4151      }
4152    }
4153  }
4154  if (delete_w) delete w;
4155  res->data=(void *)po;
4156  return FALSE;
4157}
4158static BOOLEAN jjHILBERT(leftv, leftv v)
4159{
4160#ifdef HAVE_RINGS
4161  if (rField_is_Ring_Z(currRing))
4162  {
4163    ring origR = currRing;
4164    ring tempR = rCopy(origR);
4165    coeffs new_cf=nInitChar(n_Q,NULL);
4166    nKillChar(tempR->cf);
4167    tempR->cf=new_cf;
4168    rComplete(tempR);
4169    ideal vid = (ideal)v->Data();
4170    rChangeCurrRing(tempR);
4171    ideal vv = idrCopyR(vid, origR, currRing);
4172    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4173    vvAsLeftv.rtyp = IDEAL_CMD;
4174    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4175    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4176    assumeStdFlag(&vvAsLeftv);
4177    Print("// NOTE: computation of Hilbert series etc. is being\n");
4178    Print("//       performed for generic fibre, that is, over Q\n");
4179    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4180    //scHilbertPoly(vv,currQuotient);
4181    hLookSeries(vv,module_w,currQuotient);
4182    idDelete(&vv);
4183    rChangeCurrRing(origR);
4184    rDelete(tempR);
4185    return FALSE;
4186  }
4187#endif
4188  assumeStdFlag(v);
4189  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4190  //scHilbertPoly((ideal)v->Data(),currQuotient);
4191  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4192  return FALSE;
4193}
4194static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4195{
4196#ifdef HAVE_RINGS
4197  if (rField_is_Ring_Z(currRing))
4198  {
4199    Print("// NOTE: computation of Hilbert series etc. is being\n");
4200    Print("//       performed for generic fibre, that is, over Q\n");
4201  }
4202#endif
4203  res->data=(void *)hSecondSeries((intvec *)v->Data());
4204  return FALSE;
4205}
4206static BOOLEAN jjHOMOG1(leftv res, leftv v)
4207{
4208  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4209  ideal v_id=(ideal)v->Data();
4210  if (w==NULL)
4211  {
4212    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4213    if (res->data!=NULL)
4214    {
4215      if (v->rtyp==IDHDL)
4216      {
4217        char *s_isHomog=omStrDup("isHomog");
4218        if (v->e==NULL)
4219          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4220        else
4221          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4222      }
4223      else if (w!=NULL) delete w;
4224    } // if res->data==NULL then w==NULL
4225  }
4226  else
4227  {
4228    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4229    if((res->data==NULL) && (v->rtyp==IDHDL))
4230    {
4231      if (v->e==NULL)
4232        atKill((idhdl)(v->data),"isHomog");
4233      else
4234        atKill((idhdl)(v->LData()),"isHomog");
4235    }
4236  }
4237  return FALSE;
4238}
4239static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4240{
4241  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4242  setFlag(res,FLAG_STD);
4243  return FALSE;
4244}
4245static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4246{
4247  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4248  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4249  if (IDELEMS((ideal)mat)==0)
4250  {
4251    idDelete((ideal *)&mat);
4252    mat=(matrix)idInit(1,1);
4253  }
4254  else
4255  {
4256    MATROWS(mat)=1;
4257    mat->rank=1;
4258    idTest((ideal)mat);
4259  }
4260  res->data=(char *)mat;
4261  return FALSE;
4262}
4263static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4264{
4265  map m=(map)v->CopyD(MAP_CMD);
4266  omFree((ADDRESS)m->preimage);
4267  m->preimage=NULL;
4268  ideal I=(ideal)m;
4269  I->rank=1;
4270  res->data=(char *)I;
4271  return FALSE;
4272}
4273static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4274{
4275  if (currRing!=NULL)
4276  {
4277    ring q=(ring)v->Data();
4278    if (rSamePolyRep(currRing, q))
4279    {
4280      if (q->qideal==NULL)
4281        res->data=(char *)idInit(1,1);
4282      else
4283        res->data=(char *)idCopy(q->qideal);
4284      return FALSE;
4285    }
4286  }
4287  WerrorS("can only get ideal from identical qring");
4288  return TRUE;
4289}
4290static BOOLEAN jjIm2Iv(leftv res, leftv v)
4291{
4292  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4293  iv->makeVector();
4294  res->data = iv;
4295  return FALSE;
4296}
4297static BOOLEAN jjIMPART(leftv res, leftv v)
4298{
4299  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4300  return FALSE;
4301}
4302static BOOLEAN jjINDEPSET(leftv res, leftv v)
4303{
4304  assumeStdFlag(v);
4305  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4306  return FALSE;
4307}
4308static BOOLEAN jjINTERRED(leftv res, leftv v)
4309{
4310  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4311  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4312  res->data = result;
4313  return FALSE;
4314}
4315static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4316{
4317  res->data = (char *)(long)pVar((poly)v->Data());
4318  return FALSE;
4319}
4320static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4321{
4322  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4323  return FALSE;
4324}
4325static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4326{
4327  res->data = (char *)0;
4328  return FALSE;
4329}
4330static BOOLEAN jjJACOB_P(leftv res, leftv v)
4331{
4332  ideal i=idInit(currRing->N,1);
4333  int k;
4334  poly p=(poly)(v->Data());
4335  for (k=currRing->N;k>0;k--)
4336  {
4337    i->m[k-1]=pDiff(p,k);
4338  }
4339  res->data = (char *)i;
4340  return FALSE;
4341}
4342/*2
4343 * compute Jacobi matrix of a module/matrix
4344 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4345 * where Mt := transpose(M)
4346 * Note that this is consistent with the current conventions for jacob in Singular,
4347 * whereas M2 computes its transposed.
4348 */
4349static BOOLEAN jjJACOB_M(leftv res, leftv a)
4350{
4351  ideal id = (ideal)a->Data();
4352  id = idTransp(id);
4353  int W = IDELEMS(id);
4354
4355  ideal result = idInit(W * currRing->N, id->rank);
4356  poly *p = result->m;
4357
4358  for( int v = 1; v <= currRing->N; v++ )
4359  {
4360    poly* q = id->m;
4361    for( int i = 0; i < W; i++, p++, q++ )
4362      *p = pDiff( *q, v );
4363  }
4364  idDelete(&id);
4365
4366  res->data = (char *)result;
4367  return FALSE;
4368}
4369
4370
4371static BOOLEAN jjKBASE(leftv res, leftv v)
4372{
4373  assumeStdFlag(v);
4374  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4375  return FALSE;
4376}
4377#ifdef MDEBUG
4378static BOOLEAN jjpHead(leftv res, leftv v)
4379{
4380  res->data=(char *)pHead((poly)v->Data());
4381  return FALSE;
4382}
4383#endif
4384static BOOLEAN jjL2R(leftv res, leftv v)
4385{
4386  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4387  if (res->data != NULL)
4388    return FALSE;
4389  else
4390    return TRUE;
4391}
4392static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4393{
4394  poly p=(poly)v->Data();
4395  if (p==NULL)
4396  {
4397    res->data=(char *)nInit(0);
4398  }
4399  else
4400  {
4401    res->data=(char *)nCopy(pGetCoeff(p));
4402  }
4403  return FALSE;
4404}
4405static BOOLEAN jjLEADEXP(leftv res, leftv v)
4406{
4407  poly p=(poly)v->Data();
4408  int s=currRing->N;
4409  if (v->Typ()==VECTOR_CMD) s++;
4410  intvec *iv=new intvec(s);
4411  if (p!=NULL)
4412  {
4413    for(int i = currRing->N;i;i--)
4414    {
4415      (*iv)[i-1]=pGetExp(p,i);
4416    }
4417    if (s!=currRing->N)
4418      (*iv)[currRing->N]=pGetComp(p);
4419  }
4420  res->data=(char *)iv;
4421  return FALSE;
4422}
4423static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4424{
4425  poly p=(poly)v->Data();
4426  if (p == NULL)
4427  {
4428    res->data = (char*) NULL;
4429  }
4430  else
4431  {
4432    poly lm = pLmInit(p);
4433    pSetCoeff(lm, nInit(1));
4434    res->data = (char*) lm;
4435  }
4436  return FALSE;
4437}
4438static BOOLEAN jjLOAD1(leftv res, leftv v)
4439{
4440  return jjLOAD((char*)v->Data(),FALSE);
4441}
4442static BOOLEAN jjLISTRING(leftv res, leftv v)
4443{
4444  ring r=rCompose((lists)v->Data());
4445  if (r==NULL) return TRUE;
4446  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4447  res->data=(char *)r;
4448  return FALSE;
4449}
4450#if SIZEOF_LONG == 8
4451static number jjLONG2N(long d)
4452{
4453  int i=(int)d;
4454  if ((long)i == d)
4455  {
4456    return n_Init(i, coeffs_BIGINT);
4457  }
4458  else
4459  {
4460     struct snumber_dummy
4461     {
4462      mpz_t z;
4463      mpz_t n;
4464      #if defined(LDEBUG)
4465      int debug;
4466      #endif
4467      BOOLEAN s;
4468    };
4469    typedef struct snumber_dummy  *number_dummy;
4470
4471    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4472    #if defined(LDEBUG)
4473    z->debug=123456;
4474    #endif
4475    z->s=3;
4476    mpz_init_set_si(z->z,d);
4477    return (number)z;
4478  }
4479}
4480#else
4481#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4482#endif
4483static BOOLEAN jjPFAC1(leftv res, leftv v)
4484{
4485  /* call method jjPFAC2 with second argument = 0 (meaning that no
4486     valid bound for the prime factors has been given) */
4487  sleftv tmp;
4488  memset(&tmp, 0, sizeof(tmp));
4489  tmp.rtyp = INT_CMD;
4490  return jjPFAC2(res, v, &tmp);
4491}
4492static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4493{
4494  /* computes the LU-decomposition of a matrix M;
4495     i.e., M = P * L * U, where
4496        - P is a row permutation matrix,
4497        - L is in lower triangular form,
4498        - U is in upper row echelon form
4499     Then, we also have P * M = L * U.
4500     A list [P, L, U] is returned. */
4501  matrix mat = (const matrix)v->Data();
4502  if (!idIsConstant((ideal)mat))
4503  {
4504    WerrorS("matrix must be constant");
4505    return TRUE;
4506  }
4507  matrix pMat;
4508  matrix lMat;
4509  matrix uMat;
4510
4511  luDecomp(mat, pMat, lMat, uMat);
4512
4513  lists ll = (lists)omAllocBin(slists_bin);
4514  ll->Init(3);
4515  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4516  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4517  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4518  res->data=(char*)ll;
4519
4520  return FALSE;
4521}
4522static BOOLEAN jjMEMORY(leftv res, leftv v)
4523{
4524  omUpdateInfo();
4525  switch(((int)(long)v->Data()))
4526  {
4527  case 0:
4528    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4529    break;
4530  case 1:
4531    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4532    break;
4533  case 2:
4534    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4535    break;
4536  default:
4537    omPrintStats(stdout);
4538    omPrintInfo(stdout);
4539    omPrintBinStats(stdout);
4540    res->data = (char *)0;
4541    res->rtyp = NONE;
4542  }
4543  return FALSE;
4544  res->data = (char *)0;
4545  return FALSE;
4546}
4547//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4548//{
4549//  return jjMONITOR2(res,v,NULL);
4550//}
4551static BOOLEAN jjMSTD(leftv res, leftv v)
4552{
4553  int t=v->Typ();
4554  ideal r,m;
4555  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4556  lists l=(lists)omAllocBin(slists_bin);
4557  l->Init(2);
4558  l->m[0].rtyp=t;
4559  l->m[0].data=(char *)r;
4560  setFlag(&(l->m[0]),FLAG_STD);
4561  l->m[1].rtyp=t;
4562  l->m[1].data=(char *)m;
4563  res->data=(char *)l;
4564  return FALSE;
4565}
4566static BOOLEAN jjMULT(leftv res, leftv v)
4567{
4568  assumeStdFlag(v);
4569  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4570  return FALSE;
4571}
4572static BOOLEAN jjMINRES_R(leftv res, leftv v)
4573{
4574  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4575
4576  syStrategy tmp=(syStrategy)v->Data();
4577  tmp = syMinimize(tmp); // enrich itself!
4578
4579  res->data=(char *)tmp;
4580
4581  if (weights!=NULL)
4582    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4583
4584  return FALSE;
4585}
4586static BOOLEAN jjN2BI(leftv res, leftv v)
4587{
4588  number n,i; i=(number)v->Data();
4589  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4590  if (nMap!=NULL)
4591    n=nMap(i,currRing->cf,coeffs_BIGINT);
4592  else goto err;
4593  res->data=(void *)n;
4594  return FALSE;
4595err:
4596  WerrorS("cannot convert to bigint"); return TRUE;
4597}
4598static BOOLEAN jjNAMEOF(leftv res, leftv v)
4599{
4600  res->data = (char *)v->name;
4601  if (res->data==NULL) res->data=omStrDup("");
4602  v->name=NULL;
4603  return FALSE;
4604}
4605static BOOLEAN jjNAMES(leftv res, leftv v)
4606{
4607  res->data=ipNameList(((ring)v->Data())->idroot);
4608  return FALSE;
4609}
4610static BOOLEAN jjNAMES_I(leftv res, leftv v)
4611{
4612  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4613  return FALSE;
4614}
4615static BOOLEAN jjNVARS(leftv res, leftv v)
4616{
4617  res->data = (char *)(long)(((ring)(v->Data()))->N);
4618  return FALSE;
4619}
4620static BOOLEAN jjOpenClose(leftv, leftv v)
4621{
4622  si_link l=(si_link)v->Data();
4623  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4624  else                return slClose(l);
4625}
4626static BOOLEAN jjORD(leftv res, leftv v)
4627{
4628  poly p=(poly)v->Data();
4629  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4630  return FALSE;
4631}
4632static BOOLEAN jjPAR1(leftv res, leftv v)
4633{
4634  int i=(int)(long)v->Data();
4635  int p=0;
4636  p=rPar(currRing);
4637  if ((0<i) && (i<=p))
4638  {
4639    res->data=(char *)n_Param(i,currRing);
4640  }
4641  else
4642  {
4643    Werror("par number %d out of range 1..%d",i,p);
4644    return TRUE;
4645  }
4646  return FALSE;
4647}
4648static BOOLEAN jjPARDEG(leftv res, leftv v)
4649{
4650  number nn=(number)v->Data();
4651  res->data = (char *)(long)n_ParDeg(nn, currRing);
4652  return FALSE;
4653}
4654static BOOLEAN jjPARSTR1(leftv res, leftv v)
4655{
4656  if (currRing==NULL)
4657  {
4658    WerrorS("no ring active");
4659    return TRUE;
4660  }
4661  int i=(int)(long)v->Data();
4662  int p=0;
4663  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4664    res->data=omStrDup(rParameter(currRing)[i-1]);
4665  else
4666  {
4667    Werror("par number %d out of range 1..%d",i,p);
4668    return TRUE;
4669  }
4670  return FALSE;
4671}
4672static BOOLEAN jjP2BI(leftv res, leftv v)
4673{
4674  poly p=(poly)v->Data();
4675  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4676  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4677  {
4678    WerrorS("poly must be constant");
4679    return TRUE;
4680  }
4681  number i=pGetCoeff(p);
4682  number n;
4683  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4684  if (nMap!=NULL)
4685    n=nMap(i,currRing->cf,coeffs_BIGINT);
4686  else goto err;
4687  res->data=(void *)n;
4688  return FALSE;
4689err:
4690  WerrorS("cannot convert to bigint"); return TRUE;
4691}
4692static BOOLEAN jjP2I(leftv res, leftv v)
4693{
4694  poly p=(poly)v->Data();
4695  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4696  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4697  {
4698    WerrorS("poly must be constant");
4699    return TRUE;
4700  }
4701  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4702  return FALSE;
4703}
4704static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4705{
4706  map mapping=(map)v->Data();
4707  syMake(res,omStrDup(mapping->preimage));
4708  return FALSE;
4709}
4710static BOOLEAN jjPRIME(leftv res, leftv v)
4711{
4712  int i = IsPrime((int)(long)(v->Data()));
4713  res->data = (char *)(long)(i > 1 ? i : 2);
4714  return FALSE;
4715}
4716static BOOLEAN jjPRUNE(leftv res, leftv v)
4717{
4718  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4719  ideal v_id=(ideal)v->Data();
4720  if (w!=NULL)
4721  {
4722    if (!idTestHomModule(v_id,currQuotient,w))
4723    {
4724      WarnS("wrong weights");
4725      w=NULL;
4726      // and continue at the non-homog case below
4727    }
4728    else
4729    {
4730      w=ivCopy(w);
4731      intvec **ww=&w;
4732      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4733      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4734      return FALSE;
4735    }
4736  }
4737  res->data = (char *)idMinEmbedding(v_id);
4738  return FALSE;
4739}
4740static BOOLEAN jjP2N(leftv res, leftv v)
4741{
4742  number n;
4743  poly p;
4744  if (((p=(poly)v->Data())!=NULL)
4745  && (pIsConstant(p)))
4746  {
4747    n=nCopy(pGetCoeff(p));
4748  }
4749  else
4750  {
4751    n=nInit(0);
4752  }
4753  res->data = (char *)n;
4754  return FALSE;
4755}
4756static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4757{
4758  char *s= (char *)v->Data();
4759  int i = 1;
4760  for(i=0; i<sArithBase.nCmdUsed; i++)
4761  {
4762    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4763    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4764    {
4765      res->data = (char *)1;
4766      return FALSE;
4767    }
4768  }
4769  //res->data = (char *)0;
4770  return FALSE;
4771}
4772static BOOLEAN jjRANK1(leftv res, leftv v)
4773{
4774  matrix m =(matrix)v->Data();
4775  int rank = luRank(m, 0);
4776  res->data =(char *)(long)rank;
4777  return FALSE;
4778}
4779static BOOLEAN jjREAD(leftv res, leftv v)
4780{
4781  return jjREAD2(res,v,NULL);
4782}
4783static BOOLEAN jjREGULARITY(leftv res, leftv v)
4784{
4785  res->data = (char *)(long)iiRegularity((lists)v->Data());
4786  return FALSE;
4787}
4788static BOOLEAN jjREPART(leftv res, leftv v)
4789{
4790  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4791  return FALSE;
4792}
4793static BOOLEAN jjRINGLIST(leftv res, leftv v)
4794{
4795  ring r=(ring)v->Data();
4796  if (r!=NULL)
4797    res->data = (char *)rDecompose((ring)v->Data());
4798  return (r==NULL)||(res->data==NULL);
4799}
4800static BOOLEAN jjROWS(leftv res, leftv v)
4801{
4802  ideal i = (ideal)v->Data();
4803  res->data = (char *)i->rank;
4804  return FALSE;
4805}
4806static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4807{
4808  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4809  return FALSE;
4810}
4811static BOOLEAN jjROWS_IV(leftv res, leftv v)
4812{
4813  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4814  return FALSE;
4815}
4816static BOOLEAN jjRPAR(leftv res, leftv v)
4817{
4818  res->data = (char *)(long)rPar(((ring)v->Data()));
4819  return FALSE;
4820}
4821static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4822{
4823#ifdef HAVE_PLURAL
4824  const bool bIsSCA = rIsSCA(currRing);
4825#else
4826  const bool bIsSCA = false;
4827#endif
4828
4829  if ((currQuotient!=NULL) && !bIsSCA)
4830  {
4831    WerrorS("qring not supported by slimgb at the moment");
4832    return TRUE;
4833  }
4834  if (rHasLocalOrMixedOrdering_currRing())
4835  {
4836    WerrorS("ordering must be global for slimgb");
4837    return TRUE;
4838  }
4839  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4840  tHomog hom=testHomog;
4841  ideal u_id=(ideal)u->Data();
4842  if (w!=NULL)
4843  {
4844    if (!idTestHomModule(u_id,currQuotient,w))
4845    {
4846      WarnS("wrong weights");
4847      w=NULL;
4848    }
4849    else
4850    {
4851      w=ivCopy(w);
4852      hom=isHomog;
4853    }
4854  }
4855
4856  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4857  res->data=(char *)t_rep_gb(currRing,
4858    u_id,u_id->rank);
4859  //res->data=(char *)t_rep_gb(currRing, u_id);
4860
4861  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4862  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4863  return FALSE;
4864}
4865static BOOLEAN jjSBA(leftv res, leftv v)
4866{
4867  ideal result;
4868  ideal v_id=(ideal)v->Data();
4869  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4870  tHomog hom=testHomog;
4871  if (w!=NULL)
4872  {
4873    if (!idTestHomModule(v_id,currQuotient,w))
4874    {
4875      WarnS("wrong weights");
4876      w=NULL;
4877    }
4878    else
4879    {
4880      hom=isHomog;
4881      w=ivCopy(w);
4882    }
4883  }
4884  result=kSba(v_id,currQuotient,hom,&w,1,0);
4885  idSkipZeroes(result);
4886  res->data = (char *)result;
4887  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4888  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4889  return FALSE;
4890}
4891static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4892{
4893  ideal result;
4894  ideal v_id=(ideal)v->Data();
4895  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4896  tHomog hom=testHomog;
4897  if (w!=NULL)
4898  {
4899    if (!idTestHomModule(v_id,currQuotient,w))
4900    {
4901      WarnS("wrong weights");
4902      w=NULL;
4903    }
4904    else
4905    {
4906      hom=isHomog;
4907      w=ivCopy(w);
4908    }
4909  }
4910  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4911  idSkipZeroes(result);
4912  res->data = (char *)result;
4913  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4914  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4915  return FALSE;
4916}
4917static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4918{
4919  ideal result;
4920  ideal v_id=(ideal)v->Data();
4921  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4922  tHomog hom=testHomog;
4923  if (w!=NULL)
4924  {
4925    if (!idTestHomModule(v_id,currQuotient,w))
4926    {
4927      WarnS("wrong weights");
4928      w=NULL;
4929    }
4930    else
4931    {
4932      hom=isHomog;
4933      w=ivCopy(w);
4934    }
4935  }
4936  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4937  idSkipZeroes(result);
4938  res->data = (char *)result;
4939  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4940  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4941  return FALSE;
4942}
4943static BOOLEAN jjSTD(leftv res, leftv v)
4944{
4945  ideal result;
4946  ideal v_id=(ideal)v->Data();
4947  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4948  tHomog hom=testHomog;
4949  if (w!=NULL)
4950  {
4951    if (!idTestHomModule(v_id,currQuotient,w))
4952    {
4953      WarnS("wrong weights");
4954      w=NULL;
4955    }
4956    else
4957    {
4958      hom=isHomog;
4959      w=ivCopy(w);
4960    }
4961  }
4962  result=kStd(v_id,currQuotient,hom,&w);
4963  idSkipZeroes(result);
4964  res->data = (char *)result;
4965  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4966  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4967  return FALSE;
4968}
4969static BOOLEAN jjSort_Id(leftv res, leftv v)
4970{
4971  res->data = (char *)idSort((ideal)v->Data());
4972  return FALSE;
4973}
4974#ifdef HAVE_FACTORY
4975static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4976{
4977  singclap_factorize_retry=0;
4978  intvec *v=NULL;
4979  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4980  if (f==NULL) return TRUE;
4981  ivTest(v);
4982  lists l=(lists)omAllocBin(slists_bin);
4983  l->Init(2);
4984  l->m[0].rtyp=IDEAL_CMD;
4985  l->m[0].data=(void *)f;
4986  l->m[1].rtyp=INTVEC_CMD;
4987  l->m[1].data=(void *)v;
4988  res->data=(void *)l;
4989  return FALSE;
4990}
4991#endif
4992#if 1
4993static BOOLEAN jjSYZYGY(leftv res, leftv v)
4994{
4995  intvec *w=NULL;
4996  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4997  if (w!=NULL) delete w;
4998  return FALSE;
4999}
5000#else
5001// activate, if idSyz handle module weights correctly !
5002static BOOLEAN jjSYZYGY(leftv res, leftv v)
5003{
5004  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5005  ideal v_id=(ideal)v->Data();
5006  tHomog hom=testHomog;
5007  int add_row_shift=0;
5008  if (w!=NULL)
5009  {
5010    w=ivCopy(w);
5011    add_row_shift=w->min_in();
5012    (*w)-=add_row_shift;
5013    if (idTestHomModule(v_id,currQuotient,w))
5014      hom=isHomog;
5015    else
5016    {
5017      //WarnS("wrong weights");
5018      delete w; w=NULL;
5019      hom=testHomog;
5020    }
5021  }
5022  res->data = (char *)idSyzygies(v_id,hom,&w);
5023  if (w!=NULL)
5024  {
5025    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5026  }
5027  return FALSE;
5028}
5029#endif
5030static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5031{
5032  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5033  return FALSE;
5034}
5035static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5036{
5037  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5038  return FALSE;
5039}
5040static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5041{
5042  res->data = (char *)ivTranp((intvec*)(v->Data()));
5043  return FALSE;
5044}
5045#ifdef HAVE_PLURAL
5046static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5047{
5048  ring    r = (ring)a->Data();
5049  //if (rIsPluralRing(r))
5050  if (r->OrdSgn==1)
5051  {
5052    res->data = rOpposite(r);
5053  }
5054  else
5055  {
5056    WarnS("opposite only for global orderings");
5057    res->data = rCopy(r);
5058  }
5059  return FALSE;
5060}
5061static BOOLEAN jjENVELOPE(leftv res, leftv a)
5062{
5063  ring    r = (ring)a->Data();
5064  if (rIsPluralRing(r))
5065  {
5066    //    ideal   i;
5067//     if (a->rtyp == QRING_CMD)
5068//     {
5069//       i = r->qideal;
5070//       r->qideal = NULL;
5071//     }
5072    ring s = rEnvelope(r);
5073//     if (a->rtyp == QRING_CMD)
5074//     {
5075//       ideal is  = idOppose(r,i); /* twostd? */
5076//       is        = idAdd(is,i);
5077//       s->qideal = i;
5078//     }
5079    res->data = s;
5080  }
5081  else  res->data = rCopy(r);
5082  return FALSE;
5083}
5084static BOOLEAN jjTWOSTD(leftv res, leftv a)
5085{
5086  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5087  else  res->data=(ideal)a->CopyD();
5088  setFlag(res,FLAG_STD);
5089  setFlag(res,FLAG_TWOSTD);
5090  return FALSE;
5091}
5092#endif
5093
5094static BOOLEAN jjTYPEOF(leftv res, leftv v)
5095{
5096  int t=(int)(long)v->data;
5097  switch (t)
5098  {
5099    case INT_CMD:        res->data=omStrDup("int"); break;
5100    case POLY_CMD:       res->data=omStrDup("poly"); break;
5101    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5102    case STRING_CMD:     res->data=omStrDup("string"); break;
5103    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5104    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5105    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5106    case MODUL_CMD:      res->data=omStrDup("module"); break;
5107    case MAP_CMD:        res->data=omStrDup("map"); break;
5108    case PROC_CMD:       res->data=omStrDup("proc"); break;
5109    case RING_CMD:       res->data=omStrDup("ring"); break;
5110    case QRING_CMD:      res->data=omStrDup("qring"); break;
5111    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5112    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5113    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5114    case LIST_CMD:       res->data=omStrDup("list"); break;
5115    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5116    case LINK_CMD:       res->data=omStrDup("link"); break;
5117    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5118    case DEF_CMD:
5119    case NONE:           res->data=omStrDup("none"); break;
5120    default:
5121    {
5122      if (t>MAX_TOK)
5123        res->data=omStrDup(getBlackboxName(t));
5124      else
5125        res->data=omStrDup("?unknown type?");
5126      break;
5127    }
5128  }
5129  return FALSE;
5130}
5131static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5132{
5133  res->data=(char *)pIsUnivariate((poly)v->Data());
5134  return FALSE;
5135}
5136static BOOLEAN jjVAR1(leftv res, leftv v)
5137{
5138  int i=(int)(long)v->Data();
5139  if ((0<i) && (i<=currRing->N))
5140  {
5141    poly p=pOne();
5142    pSetExp(p,i,1);
5143    pSetm(p);
5144    res->data=(char *)p;
5145  }
5146  else
5147  {
5148    Werror("var number %d out of range 1..%d",i,currRing->N);
5149    return TRUE;
5150  }
5151  return FALSE;
5152}
5153static BOOLEAN jjVARSTR1(leftv res, leftv v)
5154{
5155  if (currRing==NULL)
5156  {
5157    WerrorS("no ring active");
5158    return TRUE;
5159  }
5160  int i=(int)(long)v->Data();
5161  if ((0<i) && (i<=currRing->N))
5162    res->data=omStrDup(currRing->names[i-1]);
5163  else
5164  {
5165    Werror("var number %d out of range 1..%d",i,currRing->N);
5166    return TRUE;
5167  }
5168  return FALSE;
5169}
5170static BOOLEAN jjVDIM(leftv res, leftv v)
5171{
5172  assumeStdFlag(v);
5173  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5174  return FALSE;
5175}
5176BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5177{
5178// input: u: a list with links of type
5179//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5180// returns: -1:  the read state of all links is eof
5181//          i>0: (at least) u[i] is ready
5182  lists Lforks = (lists)u->Data();
5183  int i = slStatusSsiL(Lforks, -1);
5184  if(i == -2) /* error */
5185  {
5186    return TRUE;
5187  }
5188  res->data = (void*)(long)i;
5189  return FALSE;
5190}
5191BOOLEAN jjWAITALL1(leftv res, leftv u)
5192{
5193// input: u: a list with links of type
5194//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5195// returns: -1: the read state of all links is eof
5196//           1: all links are ready
5197//              (caution: at least one is ready, but some maybe dead)
5198  lists Lforks = (lists)u->CopyD();
5199  int i;
5200  int j = -1;
5201  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5202  {
5203    i = slStatusSsiL(Lforks, -1);
5204    if(i == -2) /* error */
5205    {
5206      return TRUE;
5207    }
5208    if(i == -1)
5209    {
5210      break;
5211    }
5212    j = 1;
5213    Lforks->m[i-1].CleanUp();
5214    Lforks->m[i-1].rtyp=DEF_CMD;
5215    Lforks->m[i-1].data=NULL;
5216  }
5217  res->data = (void*)(long)j;
5218  Lforks->Clean();
5219  return FALSE;
5220}
5221
5222BOOLEAN jjLOAD(char *s, BOOLEAN autoexport)
5223{
5224  char libnamebuf[256];
5225  lib_types LT = type_of_LIB(s, libnamebuf);
5226
5227#ifdef HAVE_DYNAMIC_LOADING
5228  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5229#endif /* HAVE_DYNAMIC_LOADING */
5230  switch(LT)
5231  {
5232      default:
5233      case LT_NONE:
5234        Werror("%s: unknown type", s);
5235        break;
5236      case LT_NOTFOUND:
5237        Werror("cannot open %s", s);
5238        break;
5239
5240      case LT_SINGULAR:
5241      {
5242        char *plib = iiConvName(s);
5243        idhdl pl = IDROOT->get(plib,0);
5244        if (pl==NULL)
5245        {
5246          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5247          IDPACKAGE(pl)->language = LANG_SINGULAR;
5248          IDPACKAGE(pl)->libname=omStrDup(plib);
5249        }
5250        else if (IDTYP(pl)!=PACKAGE_CMD)
5251        {
5252          Werror("can not create package `%s`",plib);
5253          omFree(plib);
5254          return TRUE;
5255        }
5256        package savepack=currPack;
5257        currPack=IDPACKAGE(pl);
5258        IDPACKAGE(pl)->loaded=TRUE;
5259        char libnamebuf[256];
5260        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5261        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5262        currPack=savepack;
5263        IDPACKAGE(pl)->loaded=(!bo);
5264        return bo;
5265      }
5266      case LT_BUILTIN:
5267        SModulFunc_t iiGetBuiltinModInit(char*);
5268        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5269      case LT_MACH_O:
5270      case LT_ELF:
5271      case LT_HPUX:
5272#ifdef HAVE_DYNAMIC_LOADING
5273        return load_modules(s, libnamebuf, autoexport);
5274#else /* HAVE_DYNAMIC_LOADING */
5275        WerrorS("Dynamic modules are not supported by this version of Singular");
5276        break;
5277#endif /* HAVE_DYNAMIC_LOADING */
5278  }
5279  return TRUE;
5280}
5281
5282#ifdef INIT_BUG
5283#define XS(A) -((short)A)
5284#define jjstrlen       (proc1)1
5285#define jjpLength      (proc1)2
5286#define jjidElem       (proc1)3
5287#define jjmpDetBareiss (proc1)4
5288#define jjidFreeModule (proc1)5
5289#define jjidVec2Ideal  (proc1)6
5290#define jjrCharStr     (proc1)7
5291#ifndef MDEBUG
5292#define jjpHead        (proc1)8
5293#endif
5294#define jjidMinBase    (proc1)11
5295#define jjsyMinBase    (proc1)12
5296#define jjpMaxComp     (proc1)13
5297#define jjmpTrace      (proc1)14
5298#define jjmpTransp     (proc1)15
5299#define jjrOrdStr      (proc1)16
5300#define jjrVarStr      (proc1)18
5301#define jjrParStr      (proc1)19
5302#define jjCOUNT_RES    (proc1)22
5303#define jjDIM_R        (proc1)23
5304#define jjidTransp     (proc1)24
5305
5306extern struct sValCmd1 dArith1[];
5307void jjInitTab1()
5308{
5309  int i=0;
5310  for (;dArith1[i].cmd!=0;i++)
5311  {
5312    if (dArith1[i].res<0)
5313    {
5314      switch ((int)dArith1[i].p)
5315      {
5316        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5317        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5318        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5319        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5320#ifndef HAVE_FACTORY
5321        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5322#endif
5323        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5324        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5325#ifndef MDEBUG
5326        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5327#endif
5328        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5329        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5330        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5331        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5332        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5333        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5334        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5335        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5336        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5337        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5338        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5339        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5340      }
5341    }
5342  }
5343}
5344#else
5345#if defined(PROC_BUG)
5346#define XS(A) A
5347static BOOLEAN jjstrlen(leftv res, leftv v)
5348{
5349  res->data = (char *)strlen((char *)v->Data());
5350  return FALSE;
5351}
5352static BOOLEAN jjpLength(leftv res, leftv v)
5353{
5354  res->data = (char *)pLength((poly)v->Data());
5355  return FALSE;
5356}
5357static BOOLEAN jjidElem(leftv res, leftv v)
5358{
5359  res->data = (char *)idElem((ideal)v->Data());
5360  return FALSE;
5361}
5362static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5363{
5364  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5365  return FALSE;
5366}
5367static BOOLEAN jjidFreeModule(leftv res, leftv v)
5368{
5369  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5370  return FALSE;
5371}
5372static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5373{
5374  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5375  return FALSE;
5376}
5377static BOOLEAN jjrCharStr(leftv res, leftv v)
5378{
5379  res->data = rCharStr((ring)v->Data());
5380  return FALSE;
5381}
5382#ifndef MDEBUG
5383static BOOLEAN jjpHead(leftv res, leftv v)
5384{
5385  res->data = (char *)pHead((poly)v->Data());
5386  return FALSE;
5387}
5388#endif
5389static BOOLEAN jjidHead(leftv res, leftv v)
5390{
5391  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5392  return FALSE;
5393}
5394static BOOLEAN jjidMinBase(leftv res, leftv v)
5395{
5396  res->data = (char *)idMinBase((ideal)v->Data());
5397  return FALSE;
5398}
5399static BOOLEAN jjsyMinBase(leftv res, leftv v)
5400{
5401  res->data = (char *)syMinBase((ideal)v->Data());
5402  return FALSE;
5403}
5404static BOOLEAN jjpMaxComp(leftv res, leftv v)
5405{
5406  res->data = (char *)pMaxComp((poly)v->Data());
5407  return FALSE;
5408}
5409static BOOLEAN jjmpTrace(leftv res, leftv v)
5410{
5411  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5412  return FALSE;
5413}
5414static BOOLEAN jjmpTransp(leftv res, leftv v)
5415{
5416  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5417  return FALSE;
5418}
5419static BOOLEAN jjrOrdStr(leftv res, leftv v)
5420{
5421  res->data = rOrdStr((ring)v->Data());
5422  return FALSE;
5423}
5424static BOOLEAN jjrVarStr(leftv res, leftv v)
5425{
5426  res->data = rVarStr((ring)v->Data());
5427  return FALSE;
5428}
5429static BOOLEAN jjrParStr(leftv res, leftv v)
5430{
5431  res->data = rParStr((ring)v->Data());
5432  return FALSE;
5433}
5434static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5435{
5436  res->data=(char *)sySize((syStrategy)v->Data());
5437  return FALSE;
5438}
5439static BOOLEAN jjDIM_R(leftv res, leftv v)
5440{
5441  res->data = (char *)syDim((syStrategy)v->Data());
5442  return FALSE;
5443}
5444static BOOLEAN jjidTransp(leftv res, leftv v)
5445{
5446  res->data = (char *)idTransp((ideal)v->Data());
5447  return FALSE;
5448}
5449#else
5450#define XS(A)          -((short)A)
5451#define jjstrlen       (proc1)strlen
5452#define jjpLength      (proc1)pLength
5453#define jjidElem       (proc1)idElem
5454#define jjmpDetBareiss (proc1)mpDetBareiss
5455#define jjidFreeModule (proc1)idFreeModule
5456#define jjidVec2Ideal  (proc1)idVec2Ideal
5457#define jjrCharStr     (proc1)rCharStr
5458#ifndef MDEBUG
5459#define jjpHead        (proc1)pHeadProc
5460#endif
5461#define jjidHead       (proc1)idHead
5462#define jjidMinBase    (proc1)idMinBase
5463#define jjsyMinBase    (proc1)syMinBase
5464#define jjpMaxComp     (proc1)pMaxCompProc
5465#define jjrOrdStr      (proc1)rOrdStr
5466#define jjrVarStr      (proc1)rVarStr
5467#define jjrParStr      (proc1)rParStr
5468#define jjCOUNT_RES    (proc1)sySize
5469#define jjDIM_R        (proc1)syDim
5470#define jjidTransp     (proc1)idTransp
5471#endif
5472#endif
5473static BOOLEAN jjnInt(leftv res, leftv u)
5474{
5475  number n=(number)u->Data();
5476  res->data=(char *)(long)n_Int(n,currRing->cf);
5477  return FALSE;
5478}
5479static BOOLEAN jjnlInt(leftv res, leftv u)
5480{
5481  number n=(number)u->Data();
5482  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5483  return FALSE;
5484}
5485/*=================== operations with 3 args.: static proc =================*/
5486/* must be ordered: first operations for chars (infix ops),
5487 * then alphabetically */
5488static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5489{
5490  char *s= (char *)u->Data();
5491  int   r = (int)(long)v->Data();
5492  int   c = (int)(long)w->Data();
5493  int l = strlen(s);
5494
5495  if ( (r<1) || (r>l) || (c<0) )
5496  {
5497    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5498    return TRUE;
5499  }
5500  res->data = (char *)omAlloc((long)(c+1));
5501  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5502  return FALSE;
5503}
5504static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5505{
5506  intvec *iv = (intvec *)u->Data();
5507  int   r = (int)(long)v->Data();
5508  int   c = (int)(long)w->Data();
5509  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5510  {
5511    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5512           r,c,u->Fullname(),iv->rows(),iv->cols());
5513    return TRUE;
5514  }
5515  res->data=u->data; u->data=NULL;
5516  res->rtyp=u->rtyp; u->rtyp=0;
5517  res->name=u->name; u->name=NULL;
5518  Subexpr e=jjMakeSub(v);
5519          e->next=jjMakeSub(w);
5520  if (u->e==NULL) res->e=e;
5521  else
5522  {
5523    Subexpr h=u->e;
5524    while (h->next!=NULL) h=h->next;
5525    h->next=e;
5526    res->e=u->e;
5527    u->e=NULL;
5528  }
5529  return FALSE;
5530}
5531static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5532{
5533  bigintmat *bim = (bigintmat *)u->Data();
5534  int   r = (int)(long)v->Data();
5535  int   c = (int)(long)w->Data();
5536  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5537  {
5538    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5539           r,c,u->Fullname(),bim->rows(),bim->cols());
5540    return TRUE;
5541  }
5542  res->data=u->data; u->data=NULL;
5543  res->rtyp=u->rtyp; u->rtyp=0;
5544  res->name=u->name; u->name=NULL;
5545  Subexpr e=jjMakeSub(v);
5546          e->next=jjMakeSub(w);
5547  if (u->e==NULL)
5548    res->e=e;
5549  else
5550  {
5551    Subexpr h=u->e;
5552    while (h->next!=NULL) h=h->next;
5553    h->next=e;
5554    res->e=u->e;
5555    u->e=NULL;
5556  }
5557  return FALSE;
5558}
5559static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5560{
5561  matrix m= (matrix)u->Data();
5562  int   r = (int)(long)v->Data();
5563  int   c = (int)(long)w->Data();
5564  //Print("gen. elem %d, %d\n",r,c);
5565  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5566  {
5567    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5568      MATROWS(m),MATCOLS(m));
5569    return TRUE;
5570  }
5571  res->data=u->data; u->data=NULL;
5572  res->rtyp=u->rtyp; u->rtyp=0;
5573  res->name=u->name; u->name=NULL;
5574  Subexpr e=jjMakeSub(v);
5575          e->next=jjMakeSub(w);
5576  if (u->e==NULL)
5577    res->e=e;
5578  else
5579  {
5580    Subexpr h=u->e;
5581    while (h->next!=NULL) h=h->next;
5582    h->next=e;
5583    res->e=u->e;
5584    u->e=NULL;
5585  }
5586  return FALSE;
5587}
5588static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5589{
5590  sleftv t;
5591  sleftv ut;
5592  leftv p=NULL;
5593  intvec *iv=(intvec *)w->Data();
5594  int l;
5595  BOOLEAN nok;
5596
5597  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5598  {
5599    WerrorS("cannot build expression lists from unnamed objects");
5600    return TRUE;
5601  }
5602  memcpy(&ut,u,sizeof(ut));
5603  memset(&t,0,sizeof(t));
5604  t.rtyp=INT_CMD;
5605  for (l=0;l< iv->length(); l++)
5606  {
5607    t.data=(char *)(long)((*iv)[l]);
5608    if (p==NULL)
5609    {
5610      p=res;
5611    }
5612    else
5613    {
5614      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5615      p=p->next;
5616    }
5617    memcpy(u,&ut,sizeof(ut));
5618    if (u->Typ() == MATRIX_CMD)
5619      nok=jjBRACK_Ma(p,u,v,&t);
5620    else /* INTMAT_CMD */
5621      nok=jjBRACK_Im(p,u,v,&t);
5622    if (nok)
5623    {
5624      while (res->next!=NULL)
5625      {
5626        p=res->next->next;
5627        omFreeBin((ADDRESS)res->next, sleftv_bin);
5628        // res->e aufraeumen !!!!
5629        res->next=p;
5630      }
5631      return TRUE;
5632    }
5633  }
5634  return FALSE;
5635}
5636static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5637{
5638  sleftv t;
5639  sleftv ut;
5640  leftv p=NULL;
5641  intvec *iv=(intvec *)v->Data();
5642  int l;
5643  BOOLEAN nok;
5644
5645  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5646  {
5647    WerrorS("cannot build expression lists from unnamed objects");
5648    return TRUE;
5649  }
5650  memcpy(&ut,u,sizeof(ut));
5651  memset(&t,0,sizeof(t));
5652  t.rtyp=INT_CMD;
5653  for (l=0;l< iv->length(); l++)
5654  {
5655    t.data=(char *)(long)((*iv)[l]);
5656    if (p==NULL)
5657    {
5658      p=res;
5659    }
5660    else
5661    {
5662      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5663      p=p->next;
5664    }
5665    memcpy(u,&ut,sizeof(ut));
5666    if (u->Typ() == MATRIX_CMD)
5667      nok=jjBRACK_Ma(p,u,&t,w);
5668    else /* INTMAT_CMD */
5669      nok=jjBRACK_Im(p,u,&t,w);
5670    if (nok)
5671    {
5672      while (res->next!=NULL)
5673      {
5674        p=res->next->next;
5675        omFreeBin((ADDRESS)res->next, sleftv_bin);
5676        // res->e aufraeumen !!
5677        res->next=p;
5678      }
5679      return TRUE;
5680    }
5681  }
5682  return FALSE;
5683}
5684static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5685{
5686  sleftv t1,t2,ut;
5687  leftv p=NULL;
5688  intvec *vv=(intvec *)v->Data();
5689  intvec *wv=(intvec *)w->Data();
5690  int vl;
5691  int wl;
5692  BOOLEAN nok;
5693
5694  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5695  {
5696    WerrorS("cannot build expression lists from unnamed objects");
5697    return TRUE;
5698  }
5699  memcpy(&ut,u,sizeof(ut));
5700  memset(&t1,0,sizeof(sleftv));
5701  memset(&t2,0,sizeof(sleftv));
5702  t1.rtyp=INT_CMD;
5703  t2.rtyp=INT_CMD;
5704  for (vl=0;vl< vv->length(); vl++)
5705  {
5706    t1.data=(char *)(long)((*vv)[vl]);
5707    for (wl=0;wl< wv->length(); wl++)
5708    {
5709      t2.data=(char *)(long)((*wv)[wl]);
5710      if (p==NULL)
5711      {
5712        p=res;
5713      }
5714      else
5715      {
5716        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5717        p=p->next;
5718      }
5719      memcpy(u,&ut,sizeof(ut));
5720      if (u->Typ() == MATRIX_CMD)
5721        nok=jjBRACK_Ma(p,u,&t1,&t2);
5722      else /* INTMAT_CMD */
5723        nok=jjBRACK_Im(p,u,&t1,&t2);
5724      if (nok)
5725      {
5726        res->CleanUp();
5727        return TRUE;
5728      }
5729    }
5730  }
5731  return FALSE;
5732}
5733static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5734{
5735  v->next=(leftv)omAllocBin(sleftv_bin);
5736  memcpy(v->next,w,sizeof(sleftv));
5737  memset(w,0,sizeof(sleftv));
5738  return jjPROC(res,u,v);
5739}
5740static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5741{
5742  intvec *iv;
5743  ideal m;
5744  lists l=(lists)omAllocBin(slists_bin);
5745  int k=(int)(long)w->Data();
5746  if (k>=0)
5747  {
5748    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5749    l->Init(2);
5750    l->m[0].rtyp=MODUL_CMD;
5751    l->m[1].rtyp=INTVEC_CMD;
5752    l->m[0].data=(void *)m;
5753    l->m[1].data=(void *)iv;
5754  }
5755  else
5756  {
5757    m=sm_CallSolv((ideal)u->Data(), currRing);
5758    l->Init(1);
5759    l->m[0].rtyp=IDEAL_CMD;
5760    l->m[0].data=(void *)m;
5761  }
5762  res->data = (char *)l;
5763  return FALSE;
5764}
5765static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5766{
5767  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5768  {
5769    WerrorS("3rd argument must be a name of a matrix");
5770    return TRUE;
5771  }
5772  ideal i=(ideal)u->Data();
5773  int rank=(int)i->rank;
5774  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5775  if (r) return TRUE;
5776  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5777  return FALSE;
5778}
5779static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5780{
5781  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5782           (ideal)(v->Data()),(poly)(w->Data()));
5783  return FALSE;
5784}
5785static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5786{
5787  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5788  {
5789    WerrorS("3rd argument must be a name of a matrix");
5790    return TRUE;
5791  }
5792  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5793  poly p=(poly)u->CopyD(POLY_CMD);
5794  ideal i=idInit(1,1);
5795  i->m[0]=p;
5796  sleftv t;
5797  memset(&t,0,sizeof(t));
5798  t.data=(char *)i;
5799  t.rtyp=IDEAL_CMD;
5800  int rank=1;
5801  if (u->Typ()==VECTOR_CMD)
5802  {
5803    i->rank=rank=pMaxComp(p);
5804    t.rtyp=MODUL_CMD;
5805  }
5806  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5807  t.CleanUp();
5808  if (r) return TRUE;
5809  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5810  return FALSE;
5811}
5812static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5813{
5814  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5815    (intvec *)w->Data());
5816  //setFlag(res,FLAG_STD);
5817  return FALSE;
5818}
5819static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5820{
5821  /*4
5822  * look for the substring what in the string where
5823  * starting at position n
5824  * return the position of the first char of what in where
5825  * or 0
5826  */
5827  int n=(int)(long)w->Data();
5828  char *where=(char *)u->Data();
5829  char *what=(char *)v->Data();
5830  char *found;
5831  if ((1>n)||(n>(int)strlen(where)))
5832  {
5833    Werror("start position %d out of range",n);
5834    return TRUE;
5835  }
5836  found = strchr(where+n-1,*what);
5837  if (*(what+1)!='\0')
5838  {
5839    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5840    {
5841      found=strchr(found+1,*what);
5842    }
5843  }
5844  if (found != NULL)
5845  {
5846    res->data=(char *)((found-where)+1);
5847  }
5848  return FALSE;
5849}
5850static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5851{
5852  if ((int)(long)w->Data()==0)
5853    res->data=(char *)walkProc(u,v);
5854  else
5855    res->data=(char *)fractalWalkProc(u,v);
5856  setFlag( res, FLAG_STD );
5857  return FALSE;
5858}
5859static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5860{
5861  intvec *wdegree=(intvec*)w->Data();
5862  if (wdegree->length()!=currRing->N)
5863  {
5864    Werror("weight vector must have size %d, not %d",
5865           currRing->N,wdegree->length());
5866    return TRUE;
5867  }
5868#ifdef HAVE_RINGS
5869  if (rField_is_Ring_Z(currRing))
5870  {
5871    ring origR = currRing;
5872    ring tempR = rCopy(origR);
5873    coeffs new_cf=nInitChar(n_Q,NULL);
5874    nKillChar(tempR->cf);
5875    tempR->cf=new_cf;
5876    rComplete(tempR);
5877    ideal uid = (ideal)u->Data();
5878    rChangeCurrRing(tempR);
5879    ideal uu = idrCopyR(uid, origR, currRing);
5880    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5881    uuAsLeftv.rtyp = IDEAL_CMD;
5882    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5883    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5884    assumeStdFlag(&uuAsLeftv);
5885    Print("// NOTE: computation of Hilbert series etc. is being\n");
5886    Print("//       performed for generic fibre, that is, over Q\n");
5887    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5888    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5889    int returnWithTrue = 1;
5890    switch((int)(long)v->Data())
5891    {
5892      case 1:
5893        res->data=(void *)iv;
5894        returnWithTrue = 0;
5895      case 2:
5896        res->data=(void *)hSecondSeries(iv);
5897        delete iv;
5898        returnWithTrue = 0;
5899    }
5900    if (returnWithTrue)
5901    {
5902      WerrorS(feNotImplemented);
5903      delete iv;
5904    }
5905    idDelete(&uu);
5906    rChangeCurrRing(origR);
5907    rDelete(tempR);
5908    if (returnWithTrue) return TRUE; else return FALSE;
5909  }
5910#endif
5911  assumeStdFlag(u);
5912  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5913  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5914  switch((int)(long)v->Data())
5915  {
5916    case 1:
5917      res->data=(void *)iv;
5918      return FALSE;
5919    case 2:
5920      res->data=(void *)hSecondSeries(iv);
5921      delete iv;
5922      return FALSE;
5923  }
5924  WerrorS(feNotImplemented);
5925  delete iv;
5926  return TRUE;
5927}
5928static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5929{
5930  PrintS("TODO\n");
5931  int i=pVar((poly)v->Data());
5932  if (i==0)
5933  {
5934    WerrorS("ringvar expected");
5935    return TRUE;
5936  }
5937  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5938  int d=pWTotaldegree(p);
5939  pLmDelete(p);
5940  if (d==1)
5941    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5942  else
5943    WerrorS("variable must have weight 1");
5944  return (d!=1);
5945}
5946static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5947{
5948  PrintS("TODO\n");
5949  int i=pVar((poly)v->Data());
5950  if (i==0)
5951  {
5952    WerrorS("ringvar expected");
5953    return TRUE;
5954  }
5955  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5956  int d=pWTotaldegree(p);
5957  pLmDelete(p);
5958  if (d==1)
5959    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5960  else
5961    WerrorS("variable must have weight 1");
5962  return (d!=1);
5963}
5964static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5965{
5966  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5967  intvec* arg = (intvec*) u->Data();
5968  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5969
5970  for (i=0; i<n; i++)
5971  {
5972    (*im)[i] = (*arg)[i];
5973  }
5974
5975  res->data = (char *)im;
5976  return FALSE;
5977}
5978static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5979{
5980  short *iw=iv2array((intvec *)w->Data(),currRing);
5981  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5982  omFreeSize((ADDRESS)iw,(currRing->N+1)*sizeof(short));
5983  return FALSE;
5984}
5985static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5986{
5987  if (!pIsUnit((poly)v->Data()))
5988  {
5989    WerrorS("2nd argument must be a unit");
5990    return TRUE;
5991  }
5992  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5993  return FALSE;
5994}
5995static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5996{
5997  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5998                             (intvec *)w->Data(),currRing);
5999  return FALSE;
6000}
6001static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6002{
6003  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6004  {
6005    WerrorS("2nd argument must be a diagonal matrix of units");
6006    return TRUE;
6007  }
6008  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6009                               (matrix)v->CopyD());
6010  return FALSE;
6011}
6012static BOOLEAN currRingIsOverIntegralDomain ()
6013{
6014  /* true for fields and Z, false otherwise */
6015  if (rField_is_Ring_PtoM(currRing)) return FALSE;
6016  if (rField_is_Ring_2toM(currRing)) return FALSE;
6017  if (rField_is_Ring_ModN(currRing)) return FALSE;
6018  return TRUE;
6019}
6020static BOOLEAN jjMINOR_M(leftv res, leftv v)
6021{
6022  /* Here's the use pattern for the minor command:
6023        minor ( matrix_expression m, int_expression minorSize,
6024                optional ideal_expression IasSB, optional int_expression k,
6025                optional string_expression algorithm,
6026                optional int_expression cachedMinors,
6027                optional int_expression cachedMonomials )
6028     This method here assumes that there are at least two arguments.
6029     - If IasSB is present, it must be a std basis. All minors will be
6030       reduced w.r.t. IasSB.
6031     - If k is absent, all non-zero minors will be computed.
6032       If k is present and k > 0, the first k non-zero minors will be
6033       computed.
6034       If k is present and k < 0, the first |k| minors (some of which
6035       may be zero) will be computed.
6036       If k is present and k = 0, an error is reported.
6037     - If algorithm is absent, all the following arguments must be absent too.
6038       In this case, a heuristic picks the best-suited algorithm (among
6039       Bareiss, Laplace, and Laplace with caching).
6040       If algorithm is present, it must be one of "Bareiss", "bareiss",
6041       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6042       "cache" two more arguments may be given, determining how many entries
6043       the cache may have at most, and how many cached monomials there are at
6044       most. (Cached monomials are counted over all cached polynomials.)
6045       If these two additional arguments are not provided, 200 and 100000
6046       will be used as defaults.
6047  */
6048  matrix m;
6049  leftv u=v->next;
6050  v->next=NULL;
6051  int v_typ=v->Typ();
6052  if (v_typ==MATRIX_CMD)
6053  {
6054     m = (const matrix)v->Data();
6055  }
6056  else
6057  {
6058    if (v_typ==0)
6059    {
6060      Werror("`%s` is undefined",v->Fullname());
6061      return TRUE;
6062    }
6063    // try to convert to MATRIX:
6064    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6065    BOOLEAN bo;
6066    sleftv tmp;
6067    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6068    else bo=TRUE;
6069    if (bo)
6070    {
6071      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6072      return TRUE;
6073    }
6074    m=(matrix)tmp.data;
6075  }
6076  const int mk = (const int)(long)u->Data();
6077  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6078  bool noCacheMinors = true; bool noCacheMonomials = true;
6079  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6080
6081  /* here come the different cases of correct argument sets */
6082  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6083  {
6084    IasSB = (ideal)u->next->Data();
6085    noIdeal = false;
6086    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6087    {
6088      k = (int)(long)u->next->next->Data();
6089      noK = false;
6090      assume(k != 0);
6091      if ((u->next->next->next != NULL) &&
6092          (u->next->next->next->Typ() == STRING_CMD))
6093      {
6094        algorithm = (char*)u->next->next->next->Data();
6095        noAlgorithm = false;
6096        if ((u->next->next->next->next != NULL) &&
6097            (u->next->next->next->next->Typ() == INT_CMD))
6098        {
6099          cacheMinors = (int)(long)u->next->next->next->next->Data();
6100          noCacheMinors = false;
6101          if ((u->next->next->next->next->next != NULL) &&
6102              (u->next->next->next->next->next->Typ() == INT_CMD))
6103          {
6104            cacheMonomials =
6105               (int)(long)u->next->next->next->next->next->Data();
6106            noCacheMonomials = false;
6107          }
6108        }
6109      }
6110    }
6111  }
6112  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6113  {
6114    k = (int)(long)u->next->Data();
6115    noK = false;
6116    assume(k != 0);
6117    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6118    {
6119      algorithm = (char*)u->next->next->Data();
6120      noAlgorithm = false;
6121      if ((u->next->next->next != NULL) &&
6122          (u->next->next->next->Typ() == INT_CMD))
6123      {
6124        cacheMinors = (int)(long)u->next->next->next->Data();
6125        noCacheMinors = false;
6126        if ((u->next->next->next->next != NULL) &&
6127            (u->next->next->next->next->Typ() == INT_CMD))
6128        {
6129          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6130          noCacheMonomials = false;
6131        }
6132      }
6133    }
6134  }
6135  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6136  {
6137    algorithm = (char*)u->next->Data();
6138    noAlgorithm = false;
6139    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6140    {
6141      cacheMinors = (int)(long)u->next->next->Data();
6142      noCacheMinors = false;
6143      if ((u->next->next->next != NULL) &&
6144          (u->next->next->next->Typ() == INT_CMD))
6145      {
6146        cacheMonomials = (int)(long)u->next->next->next->Data();
6147        noCacheMonomials = false;
6148      }
6149    }
6150  }
6151
6152  /* upper case conversion for the algorithm if present */
6153  if (!noAlgorithm)
6154  {
6155    if (strcmp(algorithm, "bareiss") == 0)
6156      algorithm = (char*)"Bareiss";
6157    if (strcmp(algorithm, "laplace") == 0)
6158      algorithm = (char*)"Laplace";
6159    if (strcmp(algorithm, "cache") == 0)
6160      algorithm = (char*)"Cache";
6161  }
6162
6163  v->next=u;
6164  /* here come some tests */
6165  if (!noIdeal)
6166  {
6167    assumeStdFlag(u->next);
6168  }
6169  if ((!noK) && (k == 0))
6170  {
6171    WerrorS("Provided number of minors to be computed is zero.");
6172    return TRUE;
6173  }
6174  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6175      && (strcmp(algorithm, "Laplace") != 0)
6176      && (strcmp(algorithm, "Cache") != 0))
6177  {
6178    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6179    return TRUE;
6180  }
6181  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6182      && (!currRingIsOverIntegralDomain()))
6183  {
6184    Werror("Bareiss algorithm not defined over coefficient rings %s",
6185           "with zero divisors.");
6186    return TRUE;
6187  }
6188  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6189  {
6190    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6191           m->rows(), m->cols());
6192    return TRUE;
6193  }
6194  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6195      && (noCacheMinors || noCacheMonomials))
6196  {
6197    cacheMinors = 200;
6198    cacheMonomials = 100000;
6199  }
6200
6201  /* here come the actual procedure calls */
6202  if (noAlgorithm)
6203    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6204                                       (noIdeal ? 0 : IasSB), false);
6205  else if (strcmp(algorithm, "Cache") == 0)
6206    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6207                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6208                                   cacheMonomials, false);
6209  else
6210    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6211                              (noIdeal ? 0 : IasSB), false);
6212  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6213  res->rtyp = IDEAL_CMD;
6214  return FALSE;
6215}
6216static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6217{
6218  // u: the name of the new type
6219  // v: the parent type
6220  // w: the elements
6221  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6222                                            (const char *)w->Data());
6223  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6224  return (d==NULL);
6225}
6226static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6227{
6228  // handles preimage(r,phi,i) and kernel(r,phi)
6229  idhdl h;
6230  ring rr;
6231  map mapping;
6232  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6233
6234  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6235  {
6236    WerrorS("2nd/3rd arguments must have names");
6237    return TRUE;
6238  }
6239  rr=(ring)u->Data();
6240  const char *ring_name=u->Name();
6241  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6242  {
6243    if (h->typ==MAP_CMD)
6244    {
6245      mapping=IDMAP(h);
6246      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6247      if ((preim_ring==NULL)
6248      || (IDRING(preim_ring)!=currRing))
6249      {
6250        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6251        return TRUE;
6252      }
6253    }
6254    else if (h->typ==IDEAL_CMD)
6255    {
6256      mapping=IDMAP(h);
6257    }
6258    else
6259    {
6260      Werror("`%s` is no map nor ideal",IDID(h));
6261      return TRUE;
6262    }
6263  }
6264  else
6265  {
6266    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6267    return TRUE;
6268  }
6269  ideal image;
6270  if (kernel_cmd) image=idInit(1,1);
6271  else
6272  {
6273    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6274    {
6275      if (h->typ==IDEAL_CMD)
6276      {
6277        image=IDIDEAL(h);
6278      }
6279      else
6280      {
6281        Werror("`%s` is no ideal",IDID(h));
6282        return TRUE;
6283      }
6284    }
6285    else
6286    {
6287      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6288      return TRUE;
6289    }
6290  }
6291  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6292  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6293  {
6294    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6295  }
6296  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6297  if (kernel_cmd) idDelete(&image);
6298  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6299}
6300static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6301{
6302  int di, k;
6303  int i=(int)(long)u->Data();
6304  int r=(int)(long)v->Data();
6305  int c=(int)(long)w->Data();
6306  if ((r<=0) || (c<=0)) return TRUE;
6307  intvec *iv = new intvec(r, c, 0);
6308  if (iv->rows()==0)
6309  {
6310    delete iv;
6311    return TRUE;
6312  }
6313  if (i!=0)
6314  {
6315    if (i<0) i = -i;
6316    di = 2 * i + 1;
6317    for (k=0; k<iv->length(); k++)
6318    {
6319      (*iv)[k] = ((siRand() % di) - i);
6320    }
6321  }
6322  res->data = (char *)iv;
6323  return FALSE;
6324}
6325static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6326  int &ringvar, poly &monomexpr)
6327{
6328  monomexpr=(poly)w->Data();
6329  poly p=(poly)v->Data();
6330#if 0
6331  if (pLength(monomexpr)>1)
6332  {
6333    Werror("`%s` substitutes a ringvar only by a term",
6334      Tok2Cmdname(SUBST_CMD));
6335    return TRUE;
6336  }
6337#endif
6338  if ((ringvar=pVar(p))==0)
6339  {
6340    if ((p!=NULL) && rField_is_Extension(currRing))
6341    {
6342      assume(currRing->cf->extRing!=NULL);
6343      number n = pGetCoeff(p);
6344      ringvar= -n_IsParam(n, currRing);
6345    }
6346    if(ringvar==0)
6347    {
6348      WerrorS("ringvar/par expected");
6349      return TRUE;
6350    }
6351  }
6352  return FALSE;
6353}
6354static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6355{
6356  int ringvar;
6357  poly monomexpr;
6358  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6359  if (nok) return TRUE;
6360  poly p=(poly)u->Data();
6361  if (ringvar>0)
6362  {
6363    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6364    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6365    {
6366      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6367      //return TRUE;
6368    }
6369    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6370      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6371    else
6372      res->data= pSubstPoly(p,ringvar,monomexpr);
6373  }
6374  else
6375  {
6376    res->data=pSubstPar(p,-ringvar,monomexpr);
6377  }
6378  return FALSE;
6379}
6380static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6381{
6382  int ringvar;
6383  poly monomexpr;
6384  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6385  if (nok) return TRUE;
6386  if (ringvar>0)
6387  {
6388    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6389      res->data = id_Subst((ideal)u->CopyD(res->rtyp), ringvar, monomexpr, currRing);
6390    else
6391      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6392  }
6393  else
6394  {
6395    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6396  }
6397  return FALSE;
6398}
6399// we do not want to have jjSUBST_Id_X inlined:
6400static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6401                            int input_type);
6402static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6403{
6404  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6405}
6406static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6407{
6408  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6409}
6410static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6411{
6412  sleftv tmp;
6413  memset(&tmp,0,sizeof(tmp));
6414  // do not check the result, conversion from int/number to poly works always
6415  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6416  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6417  tmp.CleanUp();
6418  return b;
6419}
6420static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6421{
6422  int mi=(int)(long)v->Data();
6423  int ni=(int)(long)w->Data();
6424  if ((mi<1)||(ni<1))
6425  {
6426    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6427    return TRUE;
6428  }
6429  matrix m=mpNew(mi,ni);
6430  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6431  int i=si_min(IDELEMS(I),mi*ni);
6432  //for(i=i-1;i>=0;i--)
6433  //{
6434  //  m->m[i]=I->m[i];
6435  //  I->m[i]=NULL;
6436  //}
6437  memcpy(m->m,I->m,i*sizeof(poly));
6438  memset(I->m,0,i*sizeof(poly));
6439  id_Delete(&I,currRing);
6440  res->data = (char *)m;
6441  return FALSE;
6442}
6443static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6444{
6445  int mi=(int)(long)v->Data();
6446  int ni=(int)(long)w->Data();
6447  if ((mi<1)||(ni<1))
6448  {
6449    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6450    return TRUE;
6451  }
6452  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6453           mi,ni,currRing);
6454  return FALSE;
6455}
6456static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6457{
6458  int mi=(int)(long)v->Data();
6459  int ni=(int)(long)w->Data();
6460  if ((mi<1)||(ni<1))
6461  {
6462     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6463    return TRUE;
6464  }
6465  matrix m=mpNew(mi,ni);
6466  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6467  int r=si_min(MATROWS(I),mi);
6468  int c=si_min(MATCOLS(I),ni);
6469  int i,j;
6470  for(i=r;i>0;i--)
6471  {
6472    for(j=c;j>0;j--)
6473    {
6474      MATELEM(m,i,j)=MATELEM(I,i,j);
6475      MATELEM(I,i,j)=NULL;
6476    }
6477  }
6478  id_Delete((ideal *)&I,currRing);
6479  res->data = (char *)m;
6480  return FALSE;
6481}
6482static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6483{
6484  if (w->rtyp!=IDHDL) return TRUE;
6485  int ul= IDELEMS((ideal)u->Data());
6486  int vl= IDELEMS((ideal)v->Data());
6487  ideal m
6488    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6489             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6490  if (m==NULL) return TRUE;
6491  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6492  return FALSE;
6493}
6494static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6495{
6496  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6497  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6498  idhdl hv=(idhdl)v->data;
6499  idhdl hw=(idhdl)w->data;
6500  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6501  res->data = (char *)idLiftStd((ideal)u->Data(),
6502                                &(hv->data.umatrix),testHomog,
6503                                &(hw->data.uideal));
6504  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6505  return FALSE;
6506}
6507static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6508{
6509  assumeStdFlag(v);
6510  if (!idIsZeroDim((ideal)v->Data()))
6511  {
6512    Werror("`%s` must be 0-dimensional",v->Name());
6513    return TRUE;
6514  }
6515  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6516    (poly)w->CopyD());
6517  return FALSE;
6518}
6519static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6520{
6521  assumeStdFlag(v);
6522  if (!idIsZeroDim((ideal)v->Data()))
6523  {
6524    Werror("`%s` must be 0-dimensional",v->Name());
6525    return TRUE;
6526  }
6527  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6528    (matrix)w->CopyD());
6529  return FALSE;
6530}
6531static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6532{
6533  assumeStdFlag(v);
6534  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6535    0,(int)(long)w->Data());
6536  return FALSE;
6537}
6538static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6539{
6540  assumeStdFlag(v);
6541  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6542    0,(int)(long)w->Data());
6543  return FALSE;
6544}
6545#ifdef OLD_RES
6546static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6547{
6548  int maxl=(int)v->Data();
6549  ideal u_id=(ideal)u->Data();
6550  int l=0;
6551  resolvente r;
6552  intvec **weights=NULL;
6553  int wmaxl=maxl;
6554  maxl--;
6555  if ((maxl==-1) && (iiOp!=MRES_CMD))
6556    maxl = currRing->N-1;
6557  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6558  {
6559    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6560    if (iv!=NULL)
6561    {
6562      l=1;
6563      if (!idTestHomModule(u_id,currQuotient,iv))
6564      {
6565        WarnS("wrong weights");
6566        iv=NULL;
6567      }
6568      else
6569      {
6570        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6571        weights[0] = ivCopy(iv);
6572      }
6573    }
6574    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6575  }
6576  else
6577    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6578  if (r==NULL) return TRUE;
6579  int t3=u->Typ();
6580  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6581  return FALSE;
6582}
6583#endif
6584static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6585{
6586  res->data=(void *)rInit(u,v,w);
6587  return (res->data==NULL);
6588}
6589static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6590{
6591  int yes;
6592  jjSTATUS2(res, u, v);
6593  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6594  omFree((ADDRESS) res->data);
6595  res->data = (void *)(long)yes;
6596  return FALSE;
6597}
6598static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6599{
6600  intvec *vw=(intvec *)w->Data(); // weights of vars
6601  if (vw->length()!=currRing->N)
6602  {
6603    Werror("%d weights for %d variables",vw->length(),currRing->N);
6604    return TRUE;
6605  }
6606  ideal result;
6607  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6608  tHomog hom=testHomog;
6609  ideal u_id=(ideal)(u->Data());
6610  if (ww!=NULL)
6611  {
6612    if (!idTestHomModule(u_id,currQuotient,ww))
6613    {
6614      WarnS("wrong weights");
6615      ww=NULL;
6616    }
6617    else
6618    {
6619      ww=ivCopy(ww);
6620      hom=isHomog;
6621    }
6622  }
6623  result=kStd(u_id,
6624              currQuotient,
6625              hom,
6626              &ww,                  // module weights
6627              (intvec *)v->Data(),  // hilbert series
6628              0,0,                  // syzComp, newIdeal
6629              vw);                  // weights of vars
6630  idSkipZeroes(result);
6631  res->data = (char *)result;
6632  setFlag(res,FLAG_STD);
6633  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6634  return FALSE;
6635}
6636
6637/*=================== operations with many arg.: static proc =================*/
6638/* must be ordered: first operations for chars (infix ops),
6639 * then alphabetically */
6640static BOOLEAN jjBREAK0(leftv, leftv)
6641{
6642#ifdef HAVE_SDB
6643  sdb_show_bp();
6644#endif
6645  return FALSE;
6646}
6647static BOOLEAN jjBREAK1(leftv, leftv v)
6648{
6649#ifdef HAVE_SDB
6650  if(v->Typ()==PROC_CMD)
6651  {
6652    int lineno=0;
6653    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6654    {
6655      lineno=(int)(long)v->next->Data();
6656    }
6657    return sdb_set_breakpoint(v->Name(),lineno);
6658  }
6659  return TRUE;
6660#else
6661 return FALSE;
6662#endif
6663}
6664static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6665{
6666  return iiExprArith1(res,v,iiOp);
6667}
6668static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6669{
6670  leftv v=u->next;
6671  u->next=NULL;
6672  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6673  u->next=v;
6674  return b;
6675}
6676static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6677{
6678  leftv v = u->next;
6679  leftv w = v->next;
6680  u->next = NULL;
6681  v->next = NULL;
6682  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6683  u->next = v;
6684  v->next = w;
6685  return b;
6686}
6687
6688static BOOLEAN jjCOEF_M(leftv, leftv v)
6689{
6690  if((v->Typ() != VECTOR_CMD)
6691  || (v->next->Typ() != POLY_CMD)
6692  || (v->next->next->Typ() != MATRIX_CMD)
6693  || (v->next->next->next->Typ() != MATRIX_CMD))
6694     return TRUE;
6695  if (v->next->next->rtyp!=IDHDL) return TRUE;
6696  idhdl c=(idhdl)v->next->next->data;
6697  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6698  idhdl m=(idhdl)v->next->next->next->data;
6699  idDelete((ideal *)&(c->data.uideal));
6700  idDelete((ideal *)&(m->data.uideal));
6701  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6702    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6703  return FALSE;
6704}
6705
6706static BOOLEAN jjDIVISION4(leftv res, leftv v)
6707{ // may have 3 or 4 arguments
6708  leftv v1=v;
6709  leftv v2=v1->next;
6710  leftv v3=v2->next;
6711  leftv v4=v3->next;
6712  assumeStdFlag(v2);
6713
6714  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6715  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6716
6717  if((i1==0)||(i2==0)
6718  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6719  {
6720    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6721    return TRUE;
6722  }
6723
6724  sleftv w1,w2;
6725  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6726  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6727  ideal P=(ideal)w1.Data();
6728  ideal Q=(ideal)w2.Data();
6729
6730  int n=(int)(long)v3->Data();
6731  short *w=NULL;
6732  if(v4!=NULL)
6733  {
6734    w=iv2array((intvec *)v4->Data(),currRing);
6735    short *w0=w+1;
6736    int i=currRing->N;
6737    while(i>0&&*w0>0)
6738    {
6739      w0++;
6740      i--;
6741    }
6742    if(i>0)
6743      WarnS("not all weights are positive!");
6744  }
6745
6746  matrix T;
6747  ideal R;
6748  idLiftW(P,Q,n,T,R,w);
6749
6750  w1.CleanUp();
6751  w2.CleanUp();
6752  if(w!=NULL)
6753    omFree(w);
6754
6755  lists L=(lists) omAllocBin(slists_bin);
6756  L->Init(2);
6757  L->m[1].rtyp=v1->Typ();
6758  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6759  {
6760    if(v1->Typ()==POLY_CMD)
6761      p_Shift(&R->m[0],-1,currRing);
6762    L->m[1].data=(void *)R->m[0];
6763    R->m[0]=NULL;
6764    idDelete(&R);
6765  }
6766  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6767    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6768  else
6769  {
6770    L->m[1].rtyp=MODUL_CMD;
6771    L->m[1].data=(void *)R;
6772  }
6773  L->m[0].rtyp=MATRIX_CMD;
6774  L->m[0].data=(char *)T;
6775
6776  res->data=L;
6777  res->rtyp=LIST_CMD;
6778
6779  return FALSE;
6780}
6781
6782//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6783//{
6784//  int l=u->listLength();
6785//  if (l<2) return TRUE;
6786//  BOOLEAN b;
6787//  leftv v=u->next;
6788//  leftv zz=v;
6789//  leftv z=zz;
6790//  u->next=NULL;
6791//  do
6792//  {
6793//    leftv z=z->next;
6794//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6795//    if (b) break;
6796//  } while (z!=NULL);
6797//  u->next=zz;
6798//  return b;
6799//}
6800static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6801{
6802  int s=1;
6803  leftv h=v;
6804  if (h!=NULL) s=exprlist_length(h);
6805  ideal id=idInit(s,1);
6806  int rank=1;
6807  int i=0;
6808  poly p;
6809  while (h!=NULL)
6810  {
6811    switch(h->Typ())
6812    {
6813      case POLY_CMD:
6814      {
6815        p=(poly)h->CopyD(POLY_CMD);
6816        break;
6817      }
6818      case INT_CMD:
6819      {
6820        number n=nInit((int)(long)h->Data());
6821        if (!nIsZero(n))
6822        {
6823          p=pNSet(n);
6824        }
6825        else
6826        {
6827          p=NULL;
6828          nDelete(&n);
6829        }
6830        break;
6831      }
6832      case BIGINT_CMD:
6833      {
6834        number b=(number)h->Data();
6835        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6836        if (!nIsZero(n))
6837        {
6838          p=pNSet(n);
6839        }
6840        else
6841        {
6842          p=NULL;
6843          nDelete(&n);
6844        }
6845        break;
6846      }
6847      case NUMBER_CMD:
6848      {
6849        number n=(number)h->CopyD(NUMBER_CMD);
6850        if (!nIsZero(n))
6851        {
6852          p=pNSet(n);
6853        }
6854        else
6855        {
6856          p=NULL;
6857          nDelete(&n);
6858        }
6859        break;
6860      }
6861      case VECTOR_CMD:
6862      {
6863        p=(poly)h->CopyD(VECTOR_CMD);
6864        if (iiOp!=MODUL_CMD)
6865        {
6866          idDelete(&id);
6867          pDelete(&p);
6868          return TRUE;
6869        }
6870        rank=si_max(rank,(int)pMaxComp(p));
6871        break;
6872      }
6873      default:
6874      {
6875        idDelete(&id);
6876        return TRUE;
6877      }
6878    }
6879    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6880    {
6881      pSetCompP(p,1);
6882    }
6883    id->m[i]=p;
6884    i++;
6885    h=h->next;
6886  }
6887  id->rank=rank;
6888  res->data=(char *)id;
6889  return FALSE;
6890}
6891static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6892{
6893  leftv h=v;
6894  int l=v->listLength();
6895  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6896  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6897  int t=0;
6898  // try to convert to IDEAL_CMD
6899  while (h!=NULL)
6900  {
6901    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6902    {
6903      t=IDEAL_CMD;
6904    }
6905    else break;
6906    h=h->next;
6907  }
6908  // if failure, try MODUL_CMD
6909  if (t==0)
6910  {
6911    h=v;
6912    while (h!=NULL)
6913    {
6914      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6915      {
6916        t=MODUL_CMD;
6917      }
6918      else break;
6919      h=h->next;
6920    }
6921  }
6922  // check for success  in converting
6923  if (t==0)
6924  {
6925    WerrorS("cannot convert to ideal or module");
6926    return TRUE;
6927  }
6928  // call idMultSect
6929  h=v;
6930  int i=0;
6931  sleftv tmp;
6932  while (h!=NULL)
6933  {
6934    if (h->Typ()==t)
6935    {
6936      r[i]=(ideal)h->Data(); /*no copy*/
6937      h=h->next;
6938    }
6939    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6940    {
6941      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6942      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6943      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6944      return TRUE;
6945    }
6946    else
6947    {
6948      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6949      copied[i]=TRUE;
6950      h=tmp.next;
6951    }
6952    i++;
6953  }
6954  res->rtyp=t;
6955  res->data=(char *)idMultSect(r,i);
6956  while(i>0)
6957  {
6958    i--;
6959    if (copied[i]) idDelete(&(r[i]));
6960  }
6961  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6962  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6963  return FALSE;
6964}
6965static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6966{
6967  /* computation of the inverse of a quadratic matrix A
6968     using the L-U-decomposition of A;
6969     There are two valid parametrisations:
6970     1) exactly one argument which is just the matrix A,
6971     2) exactly three arguments P, L, U which already
6972        realise the L-U-decomposition of A, that is,
6973        P * A = L * U, and P, L, and U satisfy the
6974        properties decribed in method 'jjLU_DECOMP';
6975        see there;
6976     If A is invertible, the list [1, A^(-1)] is returned,
6977     otherwise the list [0] is returned. Thus, the user may
6978     inspect the first entry of the returned list to see
6979     whether A is invertible. */
6980  matrix iMat; int invertible;
6981  if (v->next == NULL)
6982  {
6983    if (v->Typ() != MATRIX_CMD)
6984    {
6985      Werror("expected either one or three matrices");
6986      return TRUE;
6987    }
6988    else
6989    {
6990      matrix aMat = (matrix)v->Data();
6991      int rr = aMat->rows();
6992      int cc = aMat->cols();
6993      if (rr != cc)
6994      {
6995        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6996        return TRUE;
6997      }
6998      if (!idIsConstant((ideal)aMat))
6999      {
7000        WerrorS("matrix must be constant");
7001        return TRUE;
7002      }
7003      invertible = luInverse(aMat, iMat);
7004    }
7005  }
7006  else if ((v->Typ() == MATRIX_CMD) &&
7007           (v->next->Typ() == MATRIX_CMD) &&
7008           (v->next->next != NULL) &&
7009           (v->next->next->Typ() == MATRIX_CMD) &&
7010           (v->next->next->next == NULL))
7011  {
7012     matrix pMat = (matrix)v->Data();
7013     matrix lMat = (matrix)v->next->Data();
7014     matrix uMat = (matrix)v->next->next->Data();
7015     int rr = uMat->rows();
7016     int cc = uMat->cols();
7017     if (rr != cc)
7018     {
7019       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7020              rr, cc);
7021       return TRUE;
7022     }
7023      if (!idIsConstant((ideal)pMat)
7024      || (!idIsConstant((ideal)lMat))
7025      || (!idIsConstant((ideal)uMat))
7026      )
7027      {
7028        WerrorS("matricesx must be constant");
7029        return TRUE;
7030      }
7031     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7032  }
7033  else
7034  {
7035    Werror("expected either one or three matrices");
7036    return TRUE;
7037  }
7038
7039  /* build the return structure; a list with either one or two entries */
7040  lists ll = (lists)omAllocBin(slists_bin);
7041  if (invertible)
7042  {
7043    ll->Init(2);
7044    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
7045    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7046  }
7047  else
7048  {
7049    ll->Init(1);
7050    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
7051  }
7052
7053  res->data=(char*)ll;
7054  return FALSE;
7055}
7056static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7057{
7058  /* for solving a linear equation system A * x = b, via the
7059     given LU-decomposition of the matrix A;
7060     There is one valid parametrisation:
7061     1) exactly four arguments P, L, U, b;
7062        P, L, and U realise the L-U-decomposition of A, that is,
7063        P * A = L * U, and P, L, and U satisfy the
7064        properties decribed in method 'jjLU_DECOMP';
7065        see there;
7066        b is the right-hand side vector of the equation system;
7067     The method will return a list of either 1 entry or three entries:
7068     1) [0] if there is no solution to the system;
7069     2) [1, x, H] if there is at least one solution;
7070        x is any solution of the given linear system,
7071        H is the matrix with column vectors spanning the homogeneous
7072        solution space.
7073     The method produces an error if matrix and vector sizes do not fit. */
7074  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
7075      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
7076      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
7077      (v->next->next->next == NULL) ||
7078      (v->next->next->next->Typ() != MATRIX_CMD) ||
7079      (v->next->next->next->next != NULL))
7080  {
7081    WerrorS("expected exactly three matrices and one vector as input");
7082    return TRUE;
7083  }
7084  matrix pMat = (matrix)v->Data();
7085  matrix lMat = (matrix)v->next->Data();
7086  matrix uMat = (matrix)v->next->next->Data();
7087  matrix bVec = (matrix)v->next->next->next->Data();
7088  matrix xVec; int solvable; matrix homogSolSpace;
7089  if (pMat->rows() != pMat->cols())
7090  {
7091    Werror("first matrix (%d x %d) is not quadratic",
7092           pMat->rows(), pMat->cols());
7093    return TRUE;
7094  }
7095  if (lMat->rows() != lMat->cols())
7096  {
7097    Werror("second matrix (%d x %d) is not quadratic",
7098           lMat->rows(), lMat->cols());
7099    return TRUE;
7100  }
7101  if (lMat->rows() != uMat->rows())
7102  {
7103    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7104           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7105    return TRUE;
7106  }
7107  if (uMat->rows() != bVec->rows())
7108  {
7109    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7110           uMat->rows(), uMat->cols(), bVec->rows());
7111    return TRUE;
7112  }
7113  if (!idIsConstant((ideal)pMat)
7114  ||(!idIsConstant((ideal)lMat))
7115  ||(!idIsConstant((ideal)uMat))
7116  )
7117  {
7118    WerrorS("matrices must be constant");
7119    return TRUE;
7120  }
7121  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7122
7123  /* build the return structure; a list with either one or three entries */
7124  lists ll = (lists)omAllocBin(slists_bin);
7125  if (solvable)
7126  {
7127    ll->Init(3);
7128    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7129    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7130    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7131  }
7132  else
7133  {
7134    ll->Init(1);
7135    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7136  }
7137
7138  res->data=(char*)ll;
7139  return FALSE;
7140}
7141static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7142{
7143  int i=0;
7144  leftv h=v;
7145  if (h!=NULL) i=exprlist_length(h);
7146  intvec *iv=new intvec(i);
7147  i=0;
7148  while (h!=NULL)
7149  {
7150    if(h->Typ()==INT_CMD)
7151    {
7152      (*iv)[i]=(int)(long)h->Data();
7153    }
7154    else
7155    {
7156      delete iv;
7157      return TRUE;
7158    }
7159    i++;
7160    h=h->next;
7161  }
7162  res->data=(char *)iv;
7163  return FALSE;
7164}
7165static BOOLEAN jjJET4(leftv res, leftv u)
7166{
7167  leftv u1=u;
7168  leftv u2=u1->next;
7169  leftv u3=u2->next;
7170  leftv u4=u3->next;
7171  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7172  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
7173  {
7174    if(!pIsUnit((poly)u2->Data()))
7175    {
7176      WerrorS("2nd argument must be a unit");
7177      return TRUE;
7178    }
7179    res->rtyp=u1->Typ();
7180    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7181                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7182    return FALSE;
7183  }
7184  else
7185  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7186  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
7187  {
7188    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7189    {
7190      WerrorS("2nd argument must be a diagonal matrix of units");
7191      return TRUE;
7192    }
7193    res->rtyp=u1->Typ();
7194    res->data=(char*)idSeries(
7195                              (int)(long)u3->Data(),
7196                              idCopy((ideal)u1->Data()),
7197                              mp_Copy((matrix)u2->Data(), currRing),
7198                              (intvec*)u4->Data()
7199                             );
7200    return FALSE;
7201  }
7202  else
7203  {
7204    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7205           Tok2Cmdname(iiOp));
7206    return TRUE;
7207  }
7208}
7209static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7210{
7211  if ((yyInRingConstruction)
7212  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7213  {
7214    memcpy(res,u,sizeof(sleftv));
7215    memset(u,0,sizeof(sleftv));
7216    return FALSE;
7217  }
7218  leftv v=u->next;
7219  BOOLEAN b;
7220  if(v==NULL)
7221    b=iiExprArith1(res,u,iiOp);
7222  else
7223  {
7224    u->next=NULL;
7225    b=iiExprArith2(res,u,iiOp,v);
7226    u->next=v;
7227  }
7228  return b;
7229}
7230BOOLEAN jjLIST_PL(leftv res, leftv v)
7231{
7232  int sl=0;
7233  if (v!=NULL) sl = v->listLength();
7234  lists L;
7235  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7236  {
7237    int add_row_shift = 0;
7238    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7239    if (weights!=NULL)  add_row_shift=weights->min_in();
7240    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7241  }
7242  else
7243  {
7244    L=(lists)omAllocBin(slists_bin);
7245    leftv h=NULL;
7246    int i;
7247    int rt;
7248
7249    L->Init(sl);
7250    for (i=0;i<sl;i++)
7251    {
7252      if (h!=NULL)
7253      { /* e.g. not in the first step:
7254         * h is the pointer to the old sleftv,
7255         * v is the pointer to the next sleftv
7256         * (in this moment) */
7257         h->next=v;
7258      }
7259      h=v;
7260      v=v->next;
7261      h->next=NULL;
7262      rt=h->Typ();
7263      if (rt==0)
7264      {
7265        L->Clean();
7266        Werror("`%s` is undefined",h->Fullname());
7267        return TRUE;
7268      }
7269      if ((rt==RING_CMD)||(rt==QRING_CMD))
7270      {
7271        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7272        ((ring)L->m[i].data)->ref++;
7273      }
7274      else
7275        L->m[i].Copy(h);
7276    }
7277  }
7278  res->data=(char *)L;
7279  return FALSE;
7280}
7281static BOOLEAN jjNAMES0(leftv res, leftv)
7282{
7283  res->data=(void *)ipNameList(IDROOT);
7284  return FALSE;
7285}
7286static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7287{
7288  if(v==NULL)
7289  {
7290    res->data=(char *)showOption();
7291    return FALSE;
7292  }
7293  res->rtyp=NONE;
7294  return setOption(res,v);
7295}
7296static BOOLEAN jjREDUCE4(leftv res, leftv u)
7297{
7298  leftv u1=u;
7299  leftv u2=u1->next;
7300  leftv u3=u2->next;
7301  leftv u4=u3->next;
7302  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7303  {
7304    int save_d=Kstd1_deg;
7305    Kstd1_deg=(int)(long)u3->Data();
7306    kModW=(intvec *)u4->Data();
7307    BITSET save2;
7308    SI_SAVE_OPT2(save2);
7309    si_opt_2|=Sy_bit(V_DEG_STOP);
7310    u2->next=NULL;
7311    BOOLEAN r=jjCALL2ARG(res,u);
7312    kModW=NULL;
7313    Kstd1_deg=save_d;
7314    SI_RESTORE_OPT2(save2);
7315    u->next->next=u3;
7316    return r;
7317  }
7318  else
7319  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7320     (u4->Typ()==INT_CMD))
7321  {
7322    assumeStdFlag(u3);
7323    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7324    {
7325      WerrorS("2nd argument must be a diagonal matrix of units");
7326      return TRUE;
7327    }
7328    res->rtyp=IDEAL_CMD;
7329    res->data=(char*)redNF(
7330                           idCopy((ideal)u3->Data()),
7331                           idCopy((ideal)u1->Data()),
7332                           mp_Copy((matrix)u2->Data(), currRing),
7333                           (int)(long)u4->Data()
7334                          );
7335    return FALSE;
7336  }
7337  else
7338  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7339     (u4->Typ()==INT_CMD))
7340  {
7341    assumeStdFlag(u3);
7342    if(!pIsUnit((poly)u2->Data()))
7343    {
7344      WerrorS("2nd argument must be a unit");
7345      return TRUE;
7346    }
7347    res->rtyp=POLY_CMD;
7348    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7349                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7350    return FALSE;
7351  }
7352  else
7353  {
7354    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7355    return TRUE;
7356  }
7357}
7358static BOOLEAN jjREDUCE5(leftv res, leftv u)
7359{
7360  leftv u1=u;
7361  leftv u2=u1->next;
7362  leftv u3=u2->next;
7363  leftv u4=u3->next;
7364  leftv u5=u4->next;
7365  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7366     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7367  {
7368    assumeStdFlag(u3);
7369    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7370    {
7371      WerrorS("2nd argument must be a diagonal matrix of units");
7372      return TRUE;
7373    }
7374    res->rtyp=IDEAL_CMD;
7375    res->data=(char*)redNF(
7376                           idCopy((ideal)u3->Data()),
7377                           idCopy((ideal)u1->Data()),
7378                           mp_Copy((matrix)u2->Data(),currRing),
7379                           (int)(long)u4->Data(),
7380                           (intvec*)u5->Data()
7381                          );
7382    return FALSE;
7383  }
7384  else
7385  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7386     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7387  {
7388    assumeStdFlag(u3);
7389    if(!pIsUnit((poly)u2->Data()))
7390    {
7391      WerrorS("2nd argument must be a unit");
7392      return TRUE;
7393    }
7394    res->rtyp=POLY_CMD;
7395    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7396                           pCopy((poly)u2->Data()),
7397                           (int)(long)u4->Data(),(intvec*)u5->Data());
7398    return FALSE;
7399  }
7400  else
7401  {
7402    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7403           Tok2Cmdname(iiOp));
7404    return TRUE;
7405  }
7406}
7407static BOOLEAN jjRESERVED0(leftv, leftv)
7408{
7409  int i=1;
7410  int nCount = (sArithBase.nCmdUsed-1)/3;
7411  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7412  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7413  //      sArithBase.nCmdAllocated);
7414  for(i=0; i<nCount; i++)
7415  {
7416    Print("%-20s",sArithBase.sCmds[i+1].name);
7417    if(i+1+nCount<sArithBase.nCmdUsed)
7418      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7419    if(i+1+2*nCount<sArithBase.nCmdUsed)
7420      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7421    //if ((i%3)==1) PrintLn();
7422    PrintLn();
7423  }
7424  PrintLn();
7425  printBlackboxTypes();
7426  return FALSE;
7427}
7428static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7429{
7430  if (v == NULL)
7431  {
7432    res->data = omStrDup("");
7433    return FALSE;
7434  }
7435  int n = v->listLength();
7436  if (n == 1)
7437  {
7438    res->data = v->String();
7439    return FALSE;
7440  }
7441
7442  char** slist = (char**) omAlloc(n*sizeof(char*));
7443  int i, j;
7444
7445  for (i=0, j=0; i<n; i++, v = v ->next)
7446  {
7447    slist[i] = v->String();
7448    assume(slist[i] != NULL);
7449    j+=strlen(slist[i]);
7450  }
7451  char* s = (char*) omAlloc((j+1)*sizeof(char));
7452  *s='\0';
7453  for (i=0;i<n;i++)
7454  {
7455    strcat(s, slist[i]);
7456    omFree(slist[i]);
7457  }
7458  omFreeSize(slist, n*sizeof(char*));
7459  res->data = s;
7460  return FALSE;
7461}
7462static BOOLEAN jjTEST(leftv, leftv v)
7463{
7464  do
7465  {
7466    if (v->Typ()!=INT_CMD)
7467      return TRUE;
7468    test_cmd((int)(long)v->Data());
7469    v=v->next;
7470  }
7471  while (v!=NULL);
7472  return FALSE;
7473}
7474
7475#if defined(__alpha) && !defined(linux)
7476extern "C"
7477{
7478  void usleep(unsigned long usec);
7479};
7480#endif
7481static BOOLEAN jjFactModD_M(leftv res, leftv v)
7482{
7483  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7484     see a detailed documentation in /kernel/linearAlgebra.h
7485
7486     valid argument lists:
7487     - (poly h, int d),
7488     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7489     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7490                                                          in list of ring vars,
7491     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7492                                                optional: all 4 optional args
7493     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7494      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7495      has exactly two distinct monic factors [possibly with exponent > 1].)
7496     result:
7497     - list with the two factors f and g such that
7498       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7499
7500  poly h      = NULL;
7501  int  d      =    1;
7502  poly f0     = NULL;
7503  poly g0     = NULL;
7504  int  xIndex =    1;   /* default index if none provided */
7505  int  yIndex =    2;   /* default index if none provided */
7506
7507  leftv u = v; int factorsGiven = 0;
7508  if ((u == NULL) || (u->Typ() != POLY_CMD))
7509  {
7510    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7511    return TRUE;
7512  }
7513  else h = (poly)u->Data();
7514  u = u->next;
7515  if ((u == NULL) || (u->Typ() != INT_CMD))
7516  {
7517    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7518    return TRUE;
7519  }
7520  else d = (int)(long)u->Data();
7521  u = u->next;
7522  if ((u != NULL) && (u->Typ() == POLY_CMD))
7523  {
7524    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7525    {
7526      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7527      return TRUE;
7528    }
7529    else
7530    {
7531      f0 = (poly)u->Data();
7532      g0 = (poly)u->next->Data();
7533      factorsGiven = 1;
7534      u = u->next->next;
7535    }
7536  }
7537  if ((u != NULL) && (u->Typ() == INT_CMD))
7538  {
7539    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7540    {
7541      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7542      return TRUE;
7543    }
7544    else
7545    {
7546      xIndex = (int)(long)u->Data();
7547      yIndex = (int)(long)u->next->Data();
7548      u = u->next->next;
7549    }
7550  }
7551  if (u != NULL)
7552  {
7553    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7554    return TRUE;
7555  }
7556
7557  /* checks for provided arguments */
7558  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7559  {
7560    WerrorS("expected non-constant polynomial argument(s)");
7561    return TRUE;
7562  }
7563  int n = rVar(currRing);
7564  if ((xIndex < 1) || (n < xIndex))
7565  {
7566    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7567    return TRUE;
7568  }
7569  if ((yIndex < 1) || (n < yIndex))
7570  {
7571    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7572    return TRUE;
7573  }
7574  if (xIndex == yIndex)
7575  {
7576    WerrorS("expected distinct indices for variables x and y");
7577    return TRUE;
7578  }
7579
7580  /* computation of f0 and g0 if missing */
7581  if (factorsGiven == 0)
7582  {
7583#ifdef HAVE_FACTORY
7584    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7585    intvec* v = NULL;
7586    ideal i = singclap_factorize(h0, &v, 0,currRing);
7587
7588    ivTest(v);
7589
7590    if (i == NULL) return TRUE;
7591
7592    idTest(i);
7593
7594    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7595    {
7596      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7597      return TRUE;
7598    }
7599    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7600    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7601    idDelete(&i);
7602#else
7603    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7604    return TRUE;
7605#endif
7606  }
7607
7608  poly f; poly g;
7609  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7610  lists L = (lists)omAllocBin(slists_bin);
7611  L->Init(2);
7612  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7613  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7614  res->rtyp = LIST_CMD;
7615  res->data = (char*)L;
7616  return FALSE;
7617}
7618static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7619{
7620  if ((v->Typ() != LINK_CMD) ||
7621      (v->next->Typ() != STRING_CMD) ||
7622      (v->next->next->Typ() != STRING_CMD) ||
7623      (v->next->next->next->Typ() != INT_CMD))
7624    return TRUE;
7625  jjSTATUS3(res, v, v->next, v->next->next);
7626#if defined(HAVE_USLEEP)
7627  if (((long) res->data) == 0L)
7628  {
7629    int i_s = (int)(long) v->next->next->next->Data();
7630    if (i_s > 0)
7631    {
7632      usleep((int)(long) v->next->next->next->Data());
7633      jjSTATUS3(res, v, v->next, v->next->next);
7634    }
7635  }
7636#elif defined(HAVE_SLEEP)
7637  if (((int) res->data) == 0)
7638  {
7639    int i_s = (int) v->next->next->next->Data();
7640    if (i_s > 0)
7641    {
7642      sleep((is - 1)/1000000 + 1);
7643      jjSTATUS3(res, v, v->next, v->next->next);
7644    }
7645  }
7646#endif
7647  return FALSE;
7648}
7649static BOOLEAN jjSUBST_M(leftv res, leftv u)
7650{
7651  leftv v = u->next; // number of args > 0
7652  if (v==NULL) return TRUE;
7653  leftv w = v->next;
7654  if (w==NULL) return TRUE;
7655  leftv rest = w->next;;
7656
7657  u->next = NULL;
7658  v->next = NULL;
7659  w->next = NULL;
7660  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7661  if ((rest!=NULL) && (!b))
7662  {
7663    sleftv tmp_res;
7664    leftv tmp_next=res->next;
7665    res->next=rest;
7666    memset(&tmp_res,0,sizeof(tmp_res));
7667    b = iiExprArithM(&tmp_res,res,iiOp);
7668    memcpy(res,&tmp_res,sizeof(tmp_res));
7669    res->next=tmp_next;
7670  }
7671  u->next = v;
7672  v->next = w;
7673  // rest was w->next, but is already cleaned
7674  return b;
7675}
7676static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7677{
7678  if ((INPUT->Typ() != MATRIX_CMD) ||
7679      (INPUT->next->Typ() != NUMBER_CMD) ||
7680      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7681      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7682  {
7683    WerrorS("expected (matrix, number, number, number) as arguments");
7684    return TRUE;
7685  }
7686  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7687  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7688                                    (number)(v->Data()),
7689                                    (number)(w->Data()),
7690                                    (number)(x->Data()));
7691  return FALSE;
7692}
7693static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7694{ ideal result;
7695  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7696  leftv v = u->next;  /* one additional polynomial or ideal */
7697  leftv h = v->next;  /* Hilbert vector */
7698  leftv w = h->next;  /* weight vector */
7699  assumeStdFlag(u);
7700  ideal i1=(ideal)(u->Data());
7701  ideal i0;
7702  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7703  || (h->Typ()!=INTVEC_CMD)
7704  || (w->Typ()!=INTVEC_CMD))
7705  {
7706    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7707    return TRUE;
7708  }
7709  intvec *vw=(intvec *)w->Data(); // weights of vars
7710  /* merging std_hilb_w and std_1 */
7711  if (vw->length()!=currRing->N)
7712  {
7713    Werror("%d weights for %d variables",vw->length(),currRing->N);
7714    return TRUE;
7715  }
7716  int r=v->Typ();
7717  BOOLEAN cleanup_i0=FALSE;
7718  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7719  {
7720    i0=idInit(1,i1->rank);
7721    i0->m[0]=(poly)v->Data();
7722    cleanup_i0=TRUE;
7723  }
7724  else if (r==IDEAL_CMD)/* IDEAL */
7725  {
7726    i0=(ideal)v->Data();
7727  }
7728  else
7729  {
7730    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7731    return TRUE;
7732  }
7733  int ii0=idElem(i0);
7734  i1 = idSimpleAdd(i1,i0);
7735  if (cleanup_i0)
7736  {
7737    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7738    idDelete(&i0);
7739  }
7740  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7741  tHomog hom=testHomog;
7742  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7743  if (ww!=NULL)
7744  {
7745    if (!idTestHomModule(i1,currQuotient,ww))
7746    {
7747      WarnS("wrong weights");
7748      ww=NULL;
7749    }
7750    else
7751    {
7752      ww=ivCopy(ww);
7753      hom=isHomog;
7754    }
7755  }
7756  BITSET save1;
7757  SI_SAVE_OPT1(save1);
7758  si_opt_1|=Sy_bit(OPT_SB_1);
7759  result=kStd(i1,
7760              currQuotient,
7761              hom,
7762              &ww,                  // module weights
7763              (intvec *)h->Data(),  // hilbert series
7764              0,                    // syzComp, whatever it is...
7765              IDELEMS(i1)-ii0,      // new ideal
7766              vw);                  // weights of vars
7767  SI_RESTORE_OPT1(save1);
7768  idDelete(&i1);
7769  idSkipZeroes(result);
7770  res->data = (char *)result;
7771  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7772  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7773  return FALSE;
7774}
7775
7776
7777static Subexpr jjMakeSub(leftv e)
7778{
7779  assume( e->Typ()==INT_CMD );
7780  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7781  r->start =(int)(long)e->Data();
7782  return r;
7783}
7784#define D(A)    (A)
7785#define NULL_VAL NULL
7786#define IPARITH
7787#include "table.h"
7788
7789#include "iparith.inc"
7790
7791/*=================== operations with 2 args. ============================*/
7792/* must be ordered: first operations for chars (infix ops),
7793 * then alphabetically */
7794
7795BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7796{
7797  memset(res,0,sizeof(sleftv));
7798  BOOLEAN call_failed=FALSE;
7799
7800  if (!errorreported)
7801  {
7802#ifdef SIQ
7803    if (siq>0)
7804    {
7805      //Print("siq:%d\n",siq);
7806      command d=(command)omAlloc0Bin(sip_command_bin);
7807      memcpy(&d->arg1,a,sizeof(sleftv));
7808      //a->Init();
7809      memcpy(&d->arg2,b,sizeof(sleftv));
7810      //b->Init();
7811      d->argc=2;
7812      d->op=op;
7813      res->data=(char *)d;
7814      res->rtyp=COMMAND;
7815      return FALSE;
7816    }
7817#endif
7818    int at=a->Typ();
7819    int bt=b->Typ();
7820    if (at>MAX_TOK)
7821    {
7822      blackbox *bb=getBlackboxStuff(at);
7823      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7824      else          return TRUE;
7825    }
7826    else if ((bt>MAX_TOK)&&(op!='('))
7827    {
7828      blackbox *bb=getBlackboxStuff(bt);
7829      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7830      else          return TRUE;
7831    }
7832    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7833    int index=i;
7834
7835    iiOp=op;
7836    while (dArith2[i].cmd==op)
7837    {
7838      if ((at==dArith2[i].arg1)
7839      && (bt==dArith2[i].arg2))
7840      {
7841        res->rtyp=dArith2[i].res;
7842        if (currRing!=NULL)
7843        {
7844          if (check_valid(dArith2[i].valid_for,op)) break;
7845        }
7846        if (TEST_V_ALLWARN)
7847          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7848        if ((call_failed=dArith2[i].p(res,a,b)))
7849        {
7850          break;// leave loop, goto error handling
7851        }
7852        a->CleanUp();
7853        b->CleanUp();
7854        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7855        return FALSE;
7856      }
7857      i++;
7858    }
7859    // implicite type conversion ----------------------------------------------
7860    if (dArith2[i].cmd!=op)
7861    {
7862      int ai,bi;
7863      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7864      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7865      BOOLEAN failed=FALSE;
7866      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7867      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7868      while (dArith2[i].cmd==op)
7869      {
7870        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7871        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7872        {
7873          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7874          {
7875            res->rtyp=dArith2[i].res;
7876            if (currRing!=NULL)
7877            {
7878              if (check_valid(dArith2[i].valid_for,op)) break;
7879            }
7880            if (TEST_V_ALLWARN)
7881              Print("call %s(%s,%s)\n",iiTwoOps(op),
7882              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7883            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7884            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7885            || (call_failed=dArith2[i].p(res,an,bn)));
7886            // everything done, clean up temp. variables
7887            if (failed)
7888            {
7889              // leave loop, goto error handling
7890              break;
7891            }
7892            else
7893            {
7894              // everything ok, clean up and return
7895              an->CleanUp();
7896              bn->CleanUp();
7897              omFreeBin((ADDRESS)an, sleftv_bin);
7898              omFreeBin((ADDRESS)bn, sleftv_bin);
7899              a->CleanUp();
7900              b->CleanUp();
7901              return FALSE;
7902            }
7903          }
7904        }
7905        i++;
7906      }
7907      an->CleanUp();
7908      bn->CleanUp();
7909      omFreeBin((ADDRESS)an, sleftv_bin);
7910      omFreeBin((ADDRESS)bn, sleftv_bin);
7911    }
7912    // error handling ---------------------------------------------------
7913    const char *s=NULL;
7914    if (!errorreported)
7915    {
7916      if ((at==0) && (a->Fullname()!=sNoName))
7917      {
7918        s=a->Fullname();
7919      }
7920      else if ((bt==0) && (b->Fullname()!=sNoName))
7921      {
7922        s=b->Fullname();
7923      }
7924      if (s!=NULL)
7925        Werror("`%s` is not defined",s);
7926      else
7927      {
7928        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7929        s = iiTwoOps(op);
7930        if (proccall)
7931        {
7932          Werror("%s(`%s`,`%s`) failed"
7933                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7934        }
7935        else
7936        {
7937          Werror("`%s` %s `%s` failed"
7938                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7939        }
7940        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7941        {
7942          while (dArith2[i].cmd==op)
7943          {
7944            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7945            && (dArith2[i].res!=0)
7946            && (dArith2[i].p!=jjWRONG2))
7947            {
7948              if (proccall)
7949                Werror("expected %s(`%s`,`%s`)"
7950                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7951              else
7952                Werror("expected `%s` %s `%s`"
7953                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7954            }
7955            i++;
7956          }
7957        }
7958      }
7959    }
7960    res->rtyp = UNKNOWN;
7961  }
7962  a->CleanUp();
7963  b->CleanUp();
7964  return TRUE;
7965}
7966
7967/*==================== operations with 1 arg. ===============================*/
7968/* must be ordered: first operations for chars (infix ops),
7969 * then alphabetically */
7970
7971BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7972{
7973  memset(res,0,sizeof(sleftv));
7974  BOOLEAN call_failed=FALSE;
7975
7976  if (!errorreported)
7977  {
7978#ifdef SIQ
7979    if (siq>0)
7980    {
7981      //Print("siq:%d\n",siq);
7982      command d=(command)omAlloc0Bin(sip_command_bin);
7983      memcpy(&d->arg1,a,sizeof(sleftv));
7984      //a->Init();
7985      d->op=op;
7986      d->argc=1;
7987      res->data=(char *)d;
7988      res->rtyp=COMMAND;
7989      return FALSE;
7990    }
7991#endif
7992    int at=a->Typ();
7993    if (at>MAX_TOK)
7994    {
7995      blackbox *bb=getBlackboxStuff(at);
7996      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7997      else          return TRUE;
7998    }
7999
8000    BOOLEAN failed=FALSE;
8001    iiOp=op;
8002    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8003    int ti = i;
8004    while (dArith1[i].cmd==op)
8005    {
8006      if (at==dArith1[i].arg)
8007      {
8008        int r=res->rtyp=dArith1[i].res;
8009        if (currRing!=NULL)
8010        {
8011          if (check_valid(dArith1[i].valid_for,op)) break;
8012        }
8013        if (TEST_V_ALLWARN)
8014          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8015        if (r<0)
8016        {
8017          res->rtyp=-r;
8018          #ifdef PROC_BUG
8019          dArith1[i].p(res,a);
8020          #else
8021          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
8022          #endif
8023        }
8024        else if ((call_failed=dArith1[i].p(res,a)))
8025        {
8026          break;// leave loop, goto error handling
8027        }
8028        if (a->Next()!=NULL)
8029        {
8030          res->next=(leftv)omAllocBin(sleftv_bin);
8031          failed=iiExprArith1(res->next,a->next,op);
8032        }
8033        a->CleanUp();
8034        return failed;
8035      }
8036      i++;
8037    }
8038    // implicite type conversion --------------------------------------------
8039    if (dArith1[i].cmd!=op)
8040    {
8041      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8042      i=ti;
8043      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8044      while (dArith1[i].cmd==op)
8045      {
8046        int ai;
8047        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
8048        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
8049        {
8050          int r=res->rtyp=dArith1[i].res;
8051          if (currRing!=NULL)
8052          {
8053            if (check_valid(dArith1[i].valid_for,op)) break;
8054          }
8055          if (r<0)
8056          {
8057            res->rtyp=-r;
8058            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
8059            if (!failed)
8060            {
8061              #ifdef PROC_BUG
8062              dArith1[i].p(res,a);
8063              #else
8064              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
8065              #endif
8066            }
8067          }
8068          else
8069          {
8070            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
8071            || (call_failed=dArith1[i].p(res,an)));
8072          }
8073          // everything done, clean up temp. variables
8074          if (failed)
8075          {
8076            // leave loop, goto error handling
8077            break;
8078          }
8079          else
8080          {
8081            if (TEST_V_ALLWARN)
8082              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
8083            if (an->Next() != NULL)
8084            {
8085              res->next = (leftv)omAllocBin(sleftv_bin);
8086              failed=iiExprArith1(res->next,an->next,op);
8087            }
8088            // everything ok, clean up and return
8089            an->CleanUp();
8090            omFreeBin((ADDRESS)an, sleftv_bin);
8091            a->CleanUp();
8092            return failed;
8093          }
8094        }
8095        i++;
8096      }
8097      an->CleanUp();
8098      omFreeBin((ADDRESS)an, sleftv_bin);
8099    }
8100    // error handling
8101    if (!errorreported)
8102    {
8103      if ((at==0) && (a->Fullname()!=sNoName))
8104      {
8105        Werror("`%s` is not defined",a->Fullname());
8106      }
8107      else
8108      {
8109        i=ti;
8110        const char *s = iiTwoOps(op);
8111        Werror("%s(`%s`) failed"
8112                ,s,Tok2Cmdname(at));
8113        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8114        {
8115          while (dArith1[i].cmd==op)
8116          {
8117            if ((dArith1[i].res!=0)
8118            && (dArith1[i].p!=jjWRONG))
8119              Werror("expected %s(`%s`)"
8120                ,s,Tok2Cmdname(dArith1[i].arg));
8121            i++;
8122          }
8123        }
8124      }
8125    }
8126    res->rtyp = UNKNOWN;
8127  }
8128  a->CleanUp();
8129  return TRUE;
8130}
8131
8132/*=================== operations with 3 args. ============================*/
8133/* must be ordered: first operations for chars (infix ops),
8134 * then alphabetically */
8135
8136BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8137{
8138  memset(res,0,sizeof(sleftv));
8139  BOOLEAN call_failed=FALSE;
8140
8141  if (!errorreported)
8142  {
8143#ifdef SIQ
8144    if (siq>0)
8145    {
8146      //Print("siq:%d\n",siq);
8147      command d=(command)omAlloc0Bin(sip_command_bin);
8148      memcpy(&d->arg1,a,sizeof(sleftv));
8149      //a->Init();
8150      memcpy(&d->arg2,b,sizeof(sleftv));
8151      //b->Init();
8152      memcpy(&d->arg3,c,sizeof(sleftv));
8153      //c->Init();
8154      d->op=op;
8155      d->argc=3;
8156      res->data=(char *)d;
8157      res->rtyp=COMMAND;
8158      return FALSE;
8159    }
8160#endif
8161    int at=a->Typ();
8162    if (at>MAX_TOK)
8163    {
8164      blackbox *bb=getBlackboxStuff(at);
8165      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
8166      else          return TRUE;
8167    }
8168    int bt=b->Typ();
8169    int ct=c->Typ();
8170
8171    iiOp=op;
8172    int i=0;
8173    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8174    while (dArith3[i].cmd==op)
8175    {
8176      if ((at==dArith3[i].arg1)
8177      && (bt==dArith3[i].arg2)
8178      && (ct==dArith3[i].arg3))
8179      {
8180        res->rtyp=dArith3[i].res;
8181        if (currRing!=NULL)
8182        {
8183          if (check_valid(dArith3[i].valid_for,op)) break;
8184        }
8185        if (TEST_V_ALLWARN)
8186          Print("call %s(%s,%s,%s)\n",
8187            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8188        if ((call_failed=dArith3[i].p(res,a,b,c)))
8189        {
8190          break;// leave loop, goto error handling
8191        }
8192        a->CleanUp();
8193        b->CleanUp();
8194        c->CleanUp();
8195        return FALSE;
8196      }
8197      i++;
8198    }
8199    // implicite type conversion ----------------------------------------------
8200    if (dArith3[i].cmd!=op)
8201    {
8202      int ai,bi,ci;
8203      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8204      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8205      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8206      BOOLEAN failed=FALSE;
8207      i=0;
8208      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8209      while (dArith3[i].cmd==op)
8210      {
8211        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
8212        {
8213          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
8214          {
8215            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
8216            {
8217              res->rtyp=dArith3[i].res;
8218              if (currRing!=NULL)
8219              {
8220                if (check_valid(dArith3[i].valid_for,op)) break;
8221              }
8222              if (TEST_V_ALLWARN)
8223                Print("call %s(%s,%s,%s)\n",
8224                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8225                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8226              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8227                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8228                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8229                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8230              // everything done, clean up temp. variables
8231              if (failed)
8232              {
8233                // leave loop, goto error handling
8234                break;
8235              }
8236              else
8237              {
8238                // everything ok, clean up and return
8239                an->CleanUp();
8240                bn->CleanUp();
8241                cn->CleanUp();
8242                omFreeBin((ADDRESS)an, sleftv_bin);
8243                omFreeBin((ADDRESS)bn, sleftv_bin);
8244                omFreeBin((ADDRESS)cn, sleftv_bin);
8245                a->CleanUp();
8246                b->CleanUp();
8247                c->CleanUp();
8248        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8249                return FALSE;
8250              }
8251            }
8252          }
8253        }
8254        i++;
8255      }
8256      an->CleanUp();
8257      bn->CleanUp();
8258      cn->CleanUp();
8259      omFreeBin((ADDRESS)an, sleftv_bin);
8260      omFreeBin((ADDRESS)bn, sleftv_bin);
8261      omFreeBin((ADDRESS)cn, sleftv_bin);
8262    }
8263    // error handling ---------------------------------------------------
8264    if (!errorreported)
8265    {
8266      const char *s=NULL;
8267      if ((at==0) && (a->Fullname()!=sNoName))
8268      {
8269        s=a->Fullname();
8270      }
8271      else if ((bt==0) && (b->Fullname()!=sNoName))
8272      {
8273        s=b->Fullname();
8274      }
8275      else if ((ct==0) && (c->Fullname()!=sNoName))
8276      {
8277        s=c->Fullname();
8278      }
8279      if (s!=NULL)
8280        Werror("`%s` is not defined",s);
8281      else
8282      {
8283        i=0;
8284        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8285        const char *s = iiTwoOps(op);
8286        Werror("%s(`%s`,`%s`,`%s`) failed"
8287                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8288        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8289        {
8290          while (dArith3[i].cmd==op)
8291          {
8292            if(((at==dArith3[i].arg1)
8293            ||(bt==dArith3[i].arg2)
8294            ||(ct==dArith3[i].arg3))
8295            && (dArith3[i].res!=0))
8296            {
8297              Werror("expected %s(`%s`,`%s`,`%s`)"
8298                  ,s,Tok2Cmdname(dArith3[i].arg1)
8299                  ,Tok2Cmdname(dArith3[i].arg2)
8300                  ,Tok2Cmdname(dArith3[i].arg3));
8301            }
8302            i++;
8303          }
8304        }
8305      }
8306    }
8307    res->rtyp = UNKNOWN;
8308  }
8309  a->CleanUp();
8310  b->CleanUp();
8311  c->CleanUp();
8312        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8313  return TRUE;
8314}
8315/*==================== operations with many arg. ===============================*/
8316/* must be ordered: first operations for chars (infix ops),
8317 * then alphabetically */
8318
8319BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8320{
8321  // cnt = 0: all
8322  // cnt = 1: only first one
8323  leftv next;
8324  BOOLEAN failed = TRUE;
8325  if(v==NULL) return failed;
8326  res->rtyp = LIST_CMD;
8327  if(cnt) v->next = NULL;
8328  next = v->next;             // saving next-pointer
8329  failed = jjLIST_PL(res, v);
8330  v->next = next;             // writeback next-pointer
8331  return failed;
8332}
8333
8334BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8335{
8336  memset(res,0,sizeof(sleftv));
8337
8338  if (!errorreported)
8339  {
8340#ifdef SIQ
8341    if (siq>0)
8342    {
8343      //Print("siq:%d\n",siq);
8344      command d=(command)omAlloc0Bin(sip_command_bin);
8345      d->op=op;
8346      res->data=(char *)d;
8347      if (a!=NULL)
8348      {
8349        d->argc=a->listLength();
8350        // else : d->argc=0;
8351        memcpy(&d->arg1,a,sizeof(sleftv));
8352        switch(d->argc)
8353        {
8354          case 3:
8355            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8356            a->next->next->Init();
8357            /* no break */
8358          case 2:
8359            memcpy(&d->arg2,a->next,sizeof(sleftv));
8360            a->next->Init();
8361            a->next->next=d->arg2.next;
8362            d->arg2.next=NULL;
8363            /* no break */
8364          case 1:
8365            a->Init();
8366            a->next=d->arg1.next;
8367            d->arg1.next=NULL;
8368        }
8369        if (d->argc>3) a->next=NULL;
8370        a->name=NULL;
8371        a->rtyp=0;
8372        a->data=NULL;
8373        a->e=NULL;
8374        a->attribute=NULL;
8375        a->CleanUp();
8376      }
8377      res->rtyp=COMMAND;
8378      return FALSE;
8379    }
8380#endif
8381    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8382    {
8383      blackbox *bb=getBlackboxStuff(a->Typ());
8384      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8385      else          return TRUE;
8386    }
8387    BOOLEAN failed=FALSE;
8388    int args=0;
8389    if (a!=NULL) args=a->listLength();
8390
8391    iiOp=op;
8392    int i=0;
8393    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8394    while (dArithM[i].cmd==op)
8395    {
8396      if ((args==dArithM[i].number_of_args)
8397      || (dArithM[i].number_of_args==-1)
8398      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8399      {
8400        res->rtyp=dArithM[i].res;
8401        if (currRing!=NULL)
8402        {
8403          if (check_valid(dArithM[i].valid_for,op)) break;
8404        }
8405        if (TEST_V_ALLWARN)
8406          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8407        if (dArithM[i].p(res,a))
8408        {
8409          break;// leave loop, goto error handling
8410        }
8411        if (a!=NULL) a->CleanUp();
8412        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8413        return failed;
8414      }
8415      i++;
8416    }
8417    // error handling
8418    if (!errorreported)
8419    {
8420      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8421      {
8422        Werror("`%s` is not defined",a->Fullname());
8423      }
8424      else
8425      {
8426        const char *s = iiTwoOps(op);
8427        Werror("%s(...) failed",s);
8428      }
8429    }
8430    res->rtyp = UNKNOWN;
8431  }
8432  if (a!=NULL) a->CleanUp();
8433        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8434  return TRUE;
8435}
8436
8437/*=================== general utilities ============================*/
8438int IsCmd(const char *n, int & tok)
8439{
8440  int i;
8441  int an=1;
8442  int en=sArithBase.nLastIdentifier;
8443
8444  loop
8445  //for(an=0; an<sArithBase.nCmdUsed; )
8446  {
8447    if(an>=en-1)
8448    {
8449      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8450      {
8451        i=an;
8452        break;
8453      }
8454      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8455      {
8456        i=en;
8457        break;
8458      }
8459      else
8460      {
8461        // -- blackbox extensions:
8462        // return 0;
8463        return blackboxIsCmd(n,tok);
8464      }
8465    }
8466    i=(an+en)/2;
8467    if (*n < *(sArithBase.sCmds[i].name))
8468    {
8469      en=i-1;
8470    }
8471    else if (*n > *(sArithBase.sCmds[i].name))
8472    {
8473      an=i+1;
8474    }
8475    else
8476    {
8477      int v=strcmp(n,sArithBase.sCmds[i].name);
8478      if(v<0)
8479      {
8480        en=i-1;
8481      }
8482      else if(v>0)
8483      {
8484        an=i+1;
8485      }
8486      else /*v==0*/
8487      {
8488        break;
8489      }
8490    }
8491  }
8492  lastreserved=sArithBase.sCmds[i].name;
8493  tok=sArithBase.sCmds[i].tokval;
8494  if(sArithBase.sCmds[i].alias==2)
8495  {
8496    Warn("outdated identifier `%s` used - please change your code",
8497    sArithBase.sCmds[i].name);
8498    sArithBase.sCmds[i].alias=1;
8499  }
8500  if (currRingHdl==NULL)
8501  {
8502    #ifdef SIQ
8503    if (siq<=0)
8504    {
8505    #endif
8506      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8507      {
8508        WerrorS("no ring active");
8509        return 0;
8510      }
8511    #ifdef SIQ
8512    }
8513    #endif
8514  }
8515  if (!expected_parms)
8516  {
8517    switch (tok)
8518    {
8519      case IDEAL_CMD:
8520      case INT_CMD:
8521      case INTVEC_CMD:
8522      case MAP_CMD:
8523      case MATRIX_CMD:
8524      case MODUL_CMD:
8525      case POLY_CMD:
8526      case PROC_CMD:
8527      case RING_CMD:
8528      case STRING_CMD:
8529        cmdtok = tok;
8530        break;
8531    }
8532  }
8533  return sArithBase.sCmds[i].toktype;
8534}
8535static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8536{
8537  // user defined types are not in the pre-computed table:
8538  if (op>MAX_TOK) return 0;
8539
8540  int a=0;
8541  int e=len;
8542  int p=len/2;
8543  do
8544  {
8545     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8546     if (op<dArithTab[p].cmd) e=p-1;
8547     else   a = p+1;
8548     p=a+(e-a)/2;
8549  }
8550  while ( a <= e);
8551
8552  // catch missing a cmd:
8553  assume(0);
8554  return 0;
8555}
8556
8557const char * Tok2Cmdname(int tok)
8558{
8559  int i = 0;
8560  if (tok <= 0)
8561  {
8562    return sArithBase.sCmds[0].name;
8563  }
8564  if (tok==ANY_TYPE) return "any_type";
8565  if (tok==COMMAND) return "command";
8566  if (tok==NONE) return "nothing";
8567  //if (tok==IFBREAK) return "if_break";
8568  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8569  //if (tok==ORDER_VECTOR) return "ordering";
8570  //if (tok==REF_VAR) return "ref";
8571  //if (tok==OBJECT) return "object";
8572  //if (tok==PRINT_EXPR) return "print_expr";
8573  if (tok==IDHDL) return "identifier";
8574  if (tok>MAX_TOK) return getBlackboxName(tok);
8575  for(i=0; i<sArithBase.nCmdUsed; i++)
8576    //while (sArithBase.sCmds[i].tokval!=0)
8577  {
8578    if ((sArithBase.sCmds[i].tokval == tok)&&
8579        (sArithBase.sCmds[i].alias==0))
8580    {
8581      return sArithBase.sCmds[i].name;
8582    }
8583  }
8584  return sArithBase.sCmds[0].name;
8585}
8586
8587
8588/*---------------------------------------------------------------------*/
8589/**
8590 * @brief compares to entry of cmdsname-list
8591
8592 @param[in] a
8593 @param[in] b
8594
8595 @return <ReturnValue>
8596**/
8597/*---------------------------------------------------------------------*/
8598static int _gentable_sort_cmds( const void *a, const void *b )
8599{
8600  cmdnames *pCmdL = (cmdnames*)a;
8601  cmdnames *pCmdR = (cmdnames*)b;
8602
8603  if(a==NULL || b==NULL)             return 0;
8604
8605  /* empty entries goes to the end of the list for later reuse */
8606  if(pCmdL->name==NULL) return 1;
8607  if(pCmdR->name==NULL) return -1;
8608
8609  /* $INVALID$ must come first */
8610  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8611  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8612
8613  /* tokval=-1 are reserved names at the end */
8614  if (pCmdL->tokval==-1)
8615  {
8616    if (pCmdR->tokval==-1)
8617       return strcmp(pCmdL->name, pCmdR->name);
8618    /* pCmdL->tokval==-1, pCmdL goes at the end */
8619    return 1;
8620  }
8621  /* pCmdR->tokval==-1, pCmdR goes at the end */
8622  if(pCmdR->tokval==-1) return -1;
8623
8624  return strcmp(pCmdL->name, pCmdR->name);
8625}
8626
8627/*---------------------------------------------------------------------*/
8628/**
8629 * @brief initialisation of arithmetic structured data
8630
8631 @retval 0 on success
8632
8633**/
8634/*---------------------------------------------------------------------*/
8635int iiInitArithmetic()
8636{
8637  //printf("iiInitArithmetic()\n");
8638  memset(&sArithBase, 0, sizeof(sArithBase));
8639  iiInitCmdName();
8640  /* fix last-identifier */
8641#if 0
8642  /* we expect that gentable allready did every thing */
8643  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8644      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8645    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8646  }
8647#endif
8648  //Print("L=%d\n", sArithBase.nLastIdentifier);
8649
8650  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8651  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8652
8653  //iiArithAddCmd("Top", 0,-1,0);
8654
8655
8656  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8657  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8658  //         sArithBase.sCmds[i].name,
8659  //         sArithBase.sCmds[i].alias,
8660  //         sArithBase.sCmds[i].tokval,
8661  //         sArithBase.sCmds[i].toktype);
8662  //}
8663  //iiArithRemoveCmd("Top");
8664  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8665  //iiArithRemoveCmd("mygcd");
8666  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8667  return 0;
8668}
8669
8670int iiArithFindCmd(const char *szName)
8671{
8672  int an=0;
8673  int i = 0,v = 0;
8674  int en=sArithBase.nLastIdentifier;
8675
8676  loop
8677  //for(an=0; an<sArithBase.nCmdUsed; )
8678  {
8679    if(an>=en-1)
8680    {
8681      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8682      {
8683        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8684        return an;
8685      }
8686      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8687      {
8688        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8689        return en;
8690      }
8691      else
8692      {
8693        //Print("RET- 1\n");
8694        return -1;
8695      }
8696    }
8697    i=(an+en)/2;
8698    if (*szName < *(sArithBase.sCmds[i].name))
8699    {
8700      en=i-1;
8701    }
8702    else if (*szName > *(sArithBase.sCmds[i].name))
8703    {
8704      an=i+1;
8705    }
8706    else
8707    {
8708      v=strcmp(szName,sArithBase.sCmds[i].name);
8709      if(v<0)
8710      {
8711        en=i-1;
8712      }
8713      else if(v>0)
8714      {
8715        an=i+1;
8716      }
8717      else /*v==0*/
8718      {
8719        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8720        return i;
8721      }
8722    }
8723  }
8724  //if(i>=0 && i<sArithBase.nCmdUsed)
8725  //  return i;
8726  //Print("RET-2\n");
8727  return -2;
8728}
8729
8730char *iiArithGetCmd( int nPos )
8731{
8732  if(nPos<0) return NULL;
8733  if(nPos<sArithBase.nCmdUsed)
8734    return sArithBase.sCmds[nPos].name;
8735  return NULL;
8736}
8737
8738int iiArithRemoveCmd(const char *szName)
8739{
8740  int nIndex;
8741  if(szName==NULL) return -1;
8742
8743  nIndex = iiArithFindCmd(szName);
8744  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8745  {
8746    Print("'%s' not found (%d)\n", szName, nIndex);
8747    return -1;
8748  }
8749  omFree(sArithBase.sCmds[nIndex].name);
8750  sArithBase.sCmds[nIndex].name=NULL;
8751  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8752        (&_gentable_sort_cmds));
8753  sArithBase.nCmdUsed--;
8754
8755  /* fix last-identifier */
8756  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8757      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8758  {
8759    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8760  }
8761  //Print("L=%d\n", sArithBase.nLastIdentifier);
8762  return 0;
8763}
8764
8765int iiArithAddCmd(
8766  const char *szName,
8767  short nAlias,
8768  short nTokval,
8769  short nToktype,
8770  short nPos
8771  )
8772{
8773  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8774  //       nTokval, nToktype, nPos);
8775  if(nPos>=0)
8776  {
8777    // no checks: we rely on a correct generated code in iparith.inc
8778    assume(nPos < sArithBase.nCmdAllocated);
8779    assume(szName!=NULL);
8780    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8781    sArithBase.sCmds[nPos].alias   = nAlias;
8782    sArithBase.sCmds[nPos].tokval  = nTokval;
8783    sArithBase.sCmds[nPos].toktype = nToktype;
8784    sArithBase.nCmdUsed++;
8785    //if(nTokval>0) sArithBase.nLastIdentifier++;
8786  }
8787  else
8788  {
8789    if(szName==NULL) return -1;
8790    int nIndex = iiArithFindCmd(szName);
8791    if(nIndex>=0)
8792    {
8793      Print("'%s' already exists at %d\n", szName, nIndex);
8794      return -1;
8795    }
8796
8797    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8798    {
8799      /* needs to create new slots */
8800      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8801      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8802      if(sArithBase.sCmds==NULL) return -1;
8803      sArithBase.nCmdAllocated++;
8804    }
8805    /* still free slots available */
8806    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8807    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8808    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8809    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8810    sArithBase.nCmdUsed++;
8811
8812    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8813          (&_gentable_sort_cmds));
8814    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8815        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8816    {
8817      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8818    }
8819    //Print("L=%d\n", sArithBase.nLastIdentifier);
8820  }
8821  return 0;
8822}
8823
8824static BOOLEAN check_valid(const int p, const int op)
8825{
8826  #ifdef HAVE_PLURAL
8827  if (rIsPluralRing(currRing))
8828  {
8829    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8830    {
8831      WerrorS("not implemented for non-commutative rings");
8832      return TRUE;
8833    }
8834    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8835    {
8836      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8837      return FALSE;
8838    }
8839    /* else, ALLOW_PLURAL */
8840  }
8841  #endif
8842  #ifdef HAVE_RINGS
8843  if (rField_is_Ring(currRing))
8844  {
8845    if ((p & RING_MASK)==0 /*NO_RING*/)
8846    {
8847      WerrorS("not implemented for rings with rings as coeffients");
8848      return TRUE;
8849    }
8850    /* else ALLOW_RING */
8851    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8852    &&(!rField_is_Domain(currRing)))
8853    {
8854      WerrorS("domain required as coeffients");
8855      return TRUE;
8856    }
8857    /* else ALLOW_ZERODIVISOR */
8858  }
8859  #endif
8860  return FALSE;
8861}
Note: See TracBrowser for help on using the repository browser.