source: git/Singular/iparith.cc @ 0b0bc3

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