source: git/Singular/iparith.cc @ 1cbb1f4

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