source: git/Singular/iparith.cc @ f8565a

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