source: git/Singular/iparith.cc @ 09830b6

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