source: git/Singular/iparith.cc @ d47283

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