source: git/Singular/iparith.cc @ dd5534

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