source: git/Singular/iparith.cc @ 55b1687

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