source: git/Singular/iparith.cc @ 07df91

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