source: git/Singular/iparith.cc @ b77b9d

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