source: git/Singular/iparith.cc @ 146d90

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