source: git/Singular/iparith.cc @ c3238c9

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