source: git/Singular/iparith.cc @ a78130e

fieker-DuValspielwiese
Last change on this file since a78130e was 29618d, checked in by Hans Schoenemann <hannes@…>, 4 years ago
set OPT_REDTAIL_SYZ, if OPT_RETURN_SB is set applies to syz, intersect, quotient modulo: always set OPT_REDTAIL_SYZ: x_L5, deform_l
  • Property mode set to 100644
File size: 244.2 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#ifdef HAVE_SHIFTBBA
2543  if (rIsLPRing(currRing))
2544  {
2545    if (currRing->LPncGenCount < ul)
2546    {
2547      Werror("At least %d ncgen variables are needed for this computation.", ul);
2548      return TRUE;
2549    }
2550  }
2551#endif
2552  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2553                   hasFlag(u,FLAG_STD));
2554  if (m==NULL) return TRUE;
2555  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2556  return FALSE;
2557}
2558static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2559{
2560  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2561  idhdl h=(idhdl)v->data;
2562#ifdef HAVE_SHIFTBBA
2563  if (rIsLPRing(currRing))
2564  {
2565    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
2566    {
2567      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
2568      return TRUE;
2569    }
2570  }
2571#endif
2572  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2573  res->data = (char *)idLiftStd((ideal)u->Data(),
2574                                &(h->data.umatrix),testHomog);
2575  setFlag(res,FLAG_STD); v->flag=0;
2576  return FALSE;
2577}
2578static BOOLEAN jjLOAD2(leftv /*res*/, leftv/* LIB */ , leftv v)
2579{
2580  return jjLOAD((char*)v->Data(),TRUE);
2581}
2582static BOOLEAN jjLOAD_E(leftv /*res*/, leftv v, leftv u)
2583{
2584  char * s=(char *)u->Data();
2585  if(strcmp(s, "with")==0)
2586    return jjLOAD((char*)v->Data(), TRUE);
2587  if (strcmp(s,"try")==0)
2588    return jjLOAD_TRY((char*)v->Data());
2589  WerrorS("invalid second argument");
2590  WerrorS("load(\"libname\" [,option]);");
2591  return TRUE;
2592}
2593static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2594{
2595  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2596  tHomog hom=testHomog;
2597  if (w_u!=NULL)
2598  {
2599    //PrintS("modulo: wu:");w_u->show(INTVEC_CMD);PrintLn();
2600    w_u=ivCopy(w_u);
2601    hom=isHomog;
2602  }
2603  //else PrintS("modulo: wu:none\n");
2604  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2605  if (w_v!=NULL)
2606  {
2607    //PrintS("modulo: wv:");w_v->show(INTVEC_CMD);PrintLn();
2608    w_v=ivCopy(w_v);
2609    hom=isHomog;
2610  }
2611  //else PrintS("modulo: wv:none\n");
2612  if ((w_u!=NULL) && (w_v==NULL))
2613    w_v=ivCopy(w_u);
2614  if ((w_v!=NULL) && (w_u==NULL))
2615    w_u=ivCopy(w_v);
2616  ideal u_id=(ideal)u->Data();
2617  ideal v_id=(ideal)v->Data();
2618  if (w_u!=NULL)
2619  {
2620     if ((*w_u).compare((w_v))!=0)
2621     {
2622       WarnS("incompatible weights");
2623       delete w_u; w_u=NULL;
2624       hom=testHomog;
2625     }
2626     else
2627     {
2628       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
2629       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
2630       {
2631         WarnS("wrong weights");
2632         delete w_u; w_u=NULL;
2633         hom=testHomog;
2634       }
2635     }
2636  }
2637  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2638  if (w_u!=NULL)
2639  {
2640    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2641  }
2642  delete w_v;
2643  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2644  return FALSE;
2645}
2646static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2647{
2648  number q=(number)v->Data();
2649  if (n_IsZero(q,coeffs_BIGINT))
2650  {
2651    WerrorS(ii_div_by_0);
2652    return TRUE;
2653  }
2654  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2655  return FALSE;
2656}
2657static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2658{
2659  number q=(number)v->Data();
2660  if (nIsZero(q))
2661  {
2662    WerrorS(ii_div_by_0);
2663    return TRUE;
2664  }
2665  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2666  return FALSE;
2667}
2668static BOOLEAN jjMOD_P(leftv res, leftv u, leftv v)
2669{
2670  poly q=(poly)v->Data();
2671  if (q==NULL)
2672  {
2673    WerrorS(ii_div_by_0);
2674    return TRUE;
2675  }
2676  poly p=(poly)(u->Data());
2677  if (p==NULL)
2678  {
2679    res->data=NULL;
2680    return FALSE;
2681  }
2682  res->data=(void*)(singclap_pmod(p /*(poly)(u->Data())*/ ,
2683                                  q /*(poly)(v->Data())*/ ,currRing));
2684  return FALSE;
2685}
2686static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2687static BOOLEAN jjMONITOR1(leftv res, leftv v)
2688{
2689  return jjMONITOR2(res,v,NULL);
2690}
2691static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2692{
2693#if 0
2694  char *opt=(char *)v->Data();
2695  int mode=0;
2696  while(*opt!='\0')
2697  {
2698    if (*opt=='i') mode |= SI_PROT_I;
2699    else if (*opt=='o') mode |= SI_PROT_O;
2700    opt++;
2701  }
2702  monitor((char *)(u->Data()),mode);
2703#else
2704  si_link l=(si_link)u->Data();
2705  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2706  if(strcmp(l->m->type,"ASCII")!=0)
2707  {
2708    Werror("ASCII link required, not `%s`",l->m->type);
2709    slClose(l);
2710    return TRUE;
2711  }
2712  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2713  if ( l->name[0]!='\0') // "" is the stop condition
2714  {
2715    const char *opt;
2716    int mode=0;
2717    if (v==NULL) opt=(const char*)"i";
2718    else         opt=(const char *)v->Data();
2719    while(*opt!='\0')
2720    {
2721      if (*opt=='i') mode |= SI_PROT_I;
2722      else if (*opt=='o') mode |= SI_PROT_O;
2723      opt++;
2724    }
2725    monitor((FILE *)l->data,mode);
2726  }
2727  else
2728    monitor(NULL,0);
2729  return FALSE;
2730#endif
2731}
2732static BOOLEAN jjMONOM(leftv res, leftv v)
2733{
2734  intvec *iv=(intvec *)v->Data();
2735  poly p=pOne();
2736  int e;
2737  BOOLEAN err=FALSE;
2738  for(unsigned i=si_min(currRing->N,iv->length()); i>0; i--)
2739  {
2740    e=(*iv)[i-1];
2741    if (e>=0) pSetExp(p,i,e);
2742    else err=TRUE;
2743  }
2744  if (iv->length()==(currRing->N+1))
2745  {
2746    res->rtyp=VECTOR_CMD;
2747    e=(*iv)[currRing->N];
2748    if (e>=0) pSetComp(p,e);
2749    else err=TRUE;
2750  }
2751  pSetm(p);
2752  res->data=(char*)p;
2753  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2754  return err;
2755}
2756static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2757{
2758  // u: the name of the new type
2759  // v: the elements
2760  const char *s=(const char *)u->Data();
2761  newstruct_desc d=NULL;
2762  if (strlen(s)>=2)
2763  {
2764    d=newstructFromString((const char *)v->Data());
2765    if (d!=NULL) newstruct_setup(s,d);
2766  }
2767  else WerrorS("name of newstruct must be longer than 1 character");
2768  return d==NULL;
2769}
2770static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2771{
2772  idhdl h=(idhdl)u->data;
2773  int i=(int)(long)v->Data();
2774  int p=0;
2775  if ((0<i)
2776  && (rParameter(IDRING(h))!=NULL)
2777  && (i<=(p=rPar(IDRING(h)))))
2778    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2779  else
2780  {
2781    Werror("par number %d out of range 1..%d",i,p);
2782    return TRUE;
2783  }
2784  return FALSE;
2785}
2786#ifdef HAVE_PLURAL
2787static BOOLEAN jjPlural_num_poly(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,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2798  }
2799  else
2800  {
2801    ring r=rCopy(currRing);
2802    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2803    res->data=r;
2804    return result;
2805  }
2806}
2807static BOOLEAN jjPlural_num_mat(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(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2818  }
2819  else
2820  {
2821    ring r=rCopy(currRing);
2822    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2823    res->data=r;
2824    return result;
2825  }
2826}
2827static BOOLEAN jjPlural_mat_poly(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(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2838  }
2839  else
2840  {
2841    ring r=rCopy(currRing);
2842    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2843    res->data=r;
2844    return result;
2845  }
2846}
2847static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2848{
2849  if( currRing->qideal != NULL )
2850  {
2851    WerrorS("basering must NOT be a qring!");
2852    return TRUE;
2853  }
2854
2855  if (iiOp==NCALGEBRA_CMD)
2856  {
2857    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2858  }
2859  else
2860  {
2861    ring r=rCopy(currRing);
2862    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2863    res->data=r;
2864    return result;
2865  }
2866}
2867static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2868{
2869  res->data=NULL;
2870
2871  if (rIsPluralRing(currRing) || rIsLPRing(currRing))
2872  {
2873    const poly q = (poly)b->Data();
2874
2875    if( q != NULL )
2876    {
2877      if( (poly)a->Data() != NULL )
2878      {
2879        if (rIsPluralRing(currRing))
2880        {
2881          poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2882          res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2883        }
2884        else if (rIsLPRing(currRing))
2885        {
2886          const poly p = (poly)a->Data();
2887          res->data = pAdd(ppMult_qq(p,q), pNeg(ppMult_qq(q,p)));
2888        }
2889      }
2890    }
2891  }
2892  return FALSE;
2893}
2894static BOOLEAN jjBRACKET_REC(leftv res, leftv a, leftv b, leftv c)
2895{
2896  res->data=NULL;
2897
2898  if (rIsLPRing(currRing) || rIsPluralRing(currRing))
2899  {
2900    const poly q = (poly)b->Data();
2901    if(q != NULL)
2902    {
2903      if((poly)a->Data() != NULL)
2904      {
2905        const poly p = (poly)a->Data();
2906        int k=(int)(long)c->Data();
2907        if (k > 0)
2908        {
2909          poly qq = pCopy(q);
2910          for (int i = 0; i < k; i++)
2911          {
2912            poly qq_ref = qq;
2913            if (rIsLPRing(currRing))
2914            {
2915              qq = pAdd(ppMult_qq(p,qq), pNeg(ppMult_qq(qq,p)));
2916            }
2917            else if (rIsPluralRing(currRing))
2918            {
2919              qq = nc_p_Bracket_qq(pCopy(p), qq, currRing);
2920            }
2921            pDelete(&qq_ref);
2922            if (qq == NULL) break;
2923          }
2924          res->data = qq;
2925        }
2926        else
2927        {
2928          Werror("invalid number of iterations");
2929        }
2930      }
2931    }
2932  }
2933  return FALSE;
2934}
2935static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2936{
2937  /* number, poly, vector, ideal, module, matrix */
2938  ring  r = (ring)a->Data();
2939  if (r == currRing)
2940  {
2941    res->data = b->Data();
2942    res->rtyp = b->rtyp;
2943    return FALSE;
2944  }
2945  if (!rIsLikeOpposite(currRing, r))
2946  {
2947    Werror("%s is not an opposite ring to current ring",a->Fullname());
2948    return TRUE;
2949  }
2950  idhdl w;
2951  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2952  {
2953    int argtype = IDTYP(w);
2954    switch (argtype)
2955    {
2956    case NUMBER_CMD:
2957      {
2958        /* since basefields are equal, we can apply nCopy */
2959        res->data = nCopy((number)IDDATA(w));
2960        res->rtyp = argtype;
2961        break;
2962      }
2963    case POLY_CMD:
2964    case VECTOR_CMD:
2965      {
2966        poly    q = (poly)IDDATA(w);
2967        res->data = pOppose(r,q,currRing);
2968        res->rtyp = argtype;
2969        break;
2970      }
2971    case IDEAL_CMD:
2972    case MODUL_CMD:
2973      {
2974        ideal   Q = (ideal)IDDATA(w);
2975        res->data = idOppose(r,Q,currRing);
2976        res->rtyp = argtype;
2977        break;
2978      }
2979    case MATRIX_CMD:
2980      {
2981        ring save = currRing;
2982        rChangeCurrRing(r);
2983        matrix  m = (matrix)IDDATA(w);
2984        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2985        rChangeCurrRing(save);
2986        ideal   S = idOppose(r,Q,currRing);
2987        id_Delete(&Q, r);
2988        res->data = id_Module2Matrix(S,currRing);
2989        res->rtyp = argtype;
2990        break;
2991      }
2992    default:
2993      {
2994        WerrorS("unsupported type in oppose");
2995        return TRUE;
2996      }
2997    }
2998  }
2999  else
3000  {
3001    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
3002    return TRUE;
3003  }
3004  return FALSE;
3005}
3006#endif /* HAVE_PLURAL */
3007
3008static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
3009{
3010  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
3011    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
3012  id_DelMultiples((ideal)(res->data),currRing);
3013  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
3014  return FALSE;
3015}
3016static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
3017{
3018  int i=(int)(long)u->Data();
3019  int j=(int)(long)v->Data();
3020  if (j-i <0) {WerrorS("invalid range for random"); return TRUE;}
3021  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
3022  return FALSE;
3023}
3024static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
3025{
3026  matrix m =(matrix)u->Data();
3027  int isRowEchelon = (int)(long)v->Data();
3028  if (isRowEchelon != 1) isRowEchelon = 0;
3029  int rank = luRank(m, isRowEchelon);
3030  res->data =(char *)(long)rank;
3031  return FALSE;
3032}
3033static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
3034{
3035  si_link l=(si_link)u->Data();
3036  leftv r=slRead(l,v);
3037  if (r==NULL)
3038  {
3039    const char *s;
3040    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3041    else                            s=sNoName_fe;
3042    Werror("cannot read from `%s`",s);
3043    return TRUE;
3044  }
3045  memcpy(res,r,sizeof(sleftv));
3046  omFreeBin((ADDRESS)r, sleftv_bin);
3047  return FALSE;
3048}
3049static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
3050{
3051  ideal vi=(ideal)v->Data();
3052  if (currRing->qideal!=NULL || vi->ncols>1 || rIsPluralRing(currRing))
3053    assumeStdFlag(v);
3054  res->data = (char *)kNF(vi,currRing->qideal,(poly)u->Data());
3055  return FALSE;
3056}
3057static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
3058{
3059  ideal ui=(ideal)u->Data();
3060  ideal vi=(ideal)v->Data();
3061  if (currRing->qideal!=NULL || vi->ncols>1 || rIsPluralRing(currRing))
3062    assumeStdFlag(v);
3063  res->data = (char *)kNF(vi,currRing->qideal,ui);
3064  return FALSE;
3065}
3066static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3067{
3068  int maxl=(int)(long)v->Data();
3069  if (maxl<0)
3070  {
3071    WerrorS("length for res must not be negative");
3072    return TRUE;
3073  }
3074  syStrategy r;
3075  intvec *weights=NULL;
3076  int wmaxl=maxl;
3077  ideal u_id=(ideal)u->Data();
3078
3079  maxl--;
3080  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3081  {
3082    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3083    if (currRing->qideal!=NULL)
3084    {
3085      Warn(
3086      "full resolution in a qring may be infinite, setting max length to %d",
3087      maxl+1);
3088    }
3089  }
3090  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3091  if (weights!=NULL)
3092  {
3093    if (!idTestHomModule(u_id,currRing->qideal,weights))
3094    {
3095      WarnS("wrong weights given:");weights->show();PrintLn();
3096      weights=NULL;
3097    }
3098  }
3099  intvec *ww=NULL;
3100  int add_row_shift=0;
3101  if (weights!=NULL)
3102  {
3103     ww=ivCopy(weights);
3104     add_row_shift = ww->min_in();
3105     (*ww) -= add_row_shift;
3106  }
3107  unsigned save_opt=si_opt_1;
3108  si_opt_1 |= Sy_bit(OPT_REDTAIL_SYZ);
3109  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3110  {
3111    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3112  }
3113  else if (iiOp==SRES_CMD)
3114  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3115    r=sySchreyer(u_id,maxl+1);
3116  else if (iiOp == LRES_CMD)
3117  {
3118    int dummy;
3119    if((currRing->qideal!=NULL)||
3120    (!idHomIdeal (u_id,NULL)))
3121    {
3122       WerrorS
3123       ("`lres` not implemented for inhomogeneous input or qring");
3124       return TRUE;
3125    }
3126    if(currRing->N == 1)
3127      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3128    r=syLaScala3(u_id,&dummy);
3129  }
3130  else if (iiOp == KRES_CMD)
3131  {
3132    int dummy;
3133    if((currRing->qideal!=NULL)||
3134    (!idHomIdeal (u_id,NULL)))
3135    {
3136       WerrorS
3137       ("`kres` not implemented for inhomogeneous input or qring");
3138       return TRUE;
3139    }
3140    r=syKosz(u_id,&dummy);
3141  }
3142  else
3143  {
3144    int dummy;
3145    if((currRing->qideal!=NULL)||
3146    (!idHomIdeal (u_id,NULL)))
3147    {
3148       WerrorS
3149       ("`hres` not implemented for inhomogeneous input or qring");
3150       return TRUE;
3151    }
3152    ideal u_id_copy=idCopy(u_id);
3153    idSkipZeroes(u_id_copy);
3154    r=syHilb(u_id_copy,&dummy);
3155    idDelete(&u_id_copy);
3156  }
3157  if (r==NULL) return TRUE;
3158  if (r->list_length>wmaxl)
3159  {
3160    for(int i=wmaxl-1;i>=r->list_length;i--)
3161    {
3162      if (r->fullres[i]!=NULL) id_Delete(&r->fullres[i],currRing);
3163      if (r->minres[i]!=NULL) id_Delete(&r->minres[i],currRing);
3164    }
3165  }
3166  r->list_length=wmaxl;
3167  res->data=(void *)r;
3168  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3169  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3170  {
3171    ww=ivCopy(r->weights[0]);
3172    if (weights!=NULL) (*ww) += add_row_shift;
3173    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3174  }
3175  else
3176  {
3177    if (weights!=NULL)
3178    {
3179      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3180    }
3181  }
3182
3183  // test the La Scala case' output
3184  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3185  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3186
3187  if(iiOp != HRES_CMD)
3188    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3189  else
3190    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3191
3192  si_opt_1=save_opt;
3193  return FALSE;
3194}
3195static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3196{
3197  number n1; int i;
3198
3199  if ((u->Typ() == BIGINT_CMD) ||
3200     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3201  {
3202    n1 = (number)u->CopyD();
3203  }
3204  else if (u->Typ() == INT_CMD)
3205  {
3206    i = (int)(long)u->Data();
3207    n1 = n_Init(i, coeffs_BIGINT);
3208  }
3209  else
3210  {
3211    return TRUE;
3212  }
3213
3214  i = (int)(long)v->Data();
3215
3216  lists l = primeFactorisation(n1, i);
3217  n_Delete(&n1, coeffs_BIGINT);
3218  res->data = (char*)l;
3219  return FALSE;
3220}
3221static BOOLEAN jjRMINUS(leftv res, leftv u, leftv v)
3222{
3223  ring r=rMinusVar((ring)u->Data(),(char*)v->Data());
3224  res->data = (char *)r;
3225  return r==NULL;
3226}
3227static BOOLEAN jjRPLUS(leftv res, leftv u, leftv v)
3228{
3229  int left;
3230  if (u->Typ()==RING_CMD) left=0;
3231  else
3232  {
3233    leftv h=u;u=v;v=h;
3234    left=1;
3235  }
3236  ring r=rPlusVar((ring)u->Data(),(char*)v->Data(),left);
3237  res->data = (char *)r;
3238  return r==NULL;
3239}
3240static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3241{
3242  ring r;
3243  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3244  res->data = (char *)r;
3245  return (i==-1);
3246}
3247#define SIMPL_NORMALIZE 64
3248#define SIMPL_LMDIV 32
3249#define SIMPL_LMEQ  16
3250#define SIMPL_MULT 8
3251#define SIMPL_EQU  4
3252#define SIMPL_NULL 2
3253#define SIMPL_NORM 1
3254static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3255{
3256  int sw = (int)(long)v->Data();
3257  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3258  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3259  if (sw & SIMPL_LMDIV)
3260  {
3261    id_DelDiv(id,currRing);
3262  }
3263  if (sw & SIMPL_LMEQ)
3264  {
3265    id_DelLmEquals(id,currRing);
3266  }
3267  if (sw & SIMPL_MULT)
3268  {
3269    id_DelMultiples(id,currRing);
3270  }
3271  else if(sw & SIMPL_EQU)
3272  {
3273    id_DelEquals(id,currRing);
3274  }
3275  if (sw & SIMPL_NULL)
3276  {
3277    idSkipZeroes(id);
3278  }
3279  if (sw & SIMPL_NORM)
3280  {
3281    id_Norm(id,currRing);
3282  }
3283  if (sw & SIMPL_NORMALIZE)
3284  {
3285    id_Normalize(id,currRing);
3286  }
3287  res->data = (char * )id;
3288  return FALSE;
3289}
3290EXTERN_VAR int singclap_factorize_retry;
3291static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3292{
3293  intvec *v=NULL;
3294  int sw=(int)(long)dummy->Data();
3295  int fac_sw=sw;
3296  if (sw<0) fac_sw=1;
3297  singclap_factorize_retry=0;
3298  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3299  if (f==NULL)
3300    return TRUE;
3301  switch(sw)
3302  {
3303    case 0:
3304    case 2:
3305    {
3306      lists l=(lists)omAllocBin(slists_bin);
3307      l->Init(2);
3308      l->m[0].rtyp=IDEAL_CMD;
3309      l->m[0].data=(void *)f;
3310      l->m[1].rtyp=INTVEC_CMD;
3311      l->m[1].data=(void *)v;
3312      res->data=(void *)l;
3313      res->rtyp=LIST_CMD;
3314      return FALSE;
3315    }
3316    case 1:
3317      res->data=(void *)f;
3318      return FALSE;
3319    case 3:
3320      {
3321        poly p=f->m[0];
3322        int i=IDELEMS(f);
3323        f->m[0]=NULL;
3324        while(i>1)
3325        {
3326          i--;
3327          p=pMult(p,f->m[i]);
3328          f->m[i]=NULL;
3329        }
3330        res->data=(void *)p;
3331        res->rtyp=POLY_CMD;
3332      }
3333      return FALSE;
3334  }
3335  WerrorS("invalid switch");
3336  return FALSE;
3337}
3338static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3339{
3340  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3341  return FALSE;
3342}
3343static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3344{
3345  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3346  //return (res->data== (void*)(long)-2);
3347  return FALSE;
3348}
3349static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3350{
3351  int sw = (int)(long)v->Data();
3352  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3353  poly p = (poly)u->CopyD(POLY_CMD);
3354  if (sw & SIMPL_NORM)
3355  {
3356    pNorm(p);
3357  }
3358  if (sw & SIMPL_NORMALIZE)
3359  {
3360    p_Normalize(p,currRing);
3361  }
3362  res->data = (char * )p;
3363  return FALSE;
3364}
3365static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3366{
3367  ideal result;
3368  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3369  tHomog hom=testHomog;
3370  ideal u_id=(ideal)(u->Data());
3371  if (w!=NULL)
3372  {
3373    if (!idTestHomModule(u_id,currRing->qideal,w))
3374    {
3375      WarnS("wrong weights:");w->show();PrintLn();
3376      w=NULL;
3377    }
3378    else
3379    {
3380      w=ivCopy(w);
3381      hom=isHomog;
3382    }
3383  }
3384  result=kStd(u_id,currRing->qideal,hom,&w,(intvec *)v->Data());
3385  idSkipZeroes(result);
3386  res->data = (char *)result;
3387  setFlag(res,FLAG_STD);
3388  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3389  return FALSE;
3390}
3391static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3392{
3393  ideal result;
3394  assumeStdFlag(u);
3395  ideal i1=(ideal)(u->Data());
3396  int ii1=idElem(i1); /* size of i1 */
3397  ideal i0;
3398  int r=v->Typ();
3399  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3400  {
3401    poly p=(poly)v->Data();
3402    i0=idInit(1,i1->rank);
3403    i0->m[0]=p;
3404    i1=idSimpleAdd(i1,i0); //
3405    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3406    idDelete(&i0);
3407    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3408    tHomog hom=testHomog;
3409
3410    if (w!=NULL)
3411    {
3412      if (!idTestHomModule(i1,currRing->qideal,w))
3413      {
3414        // no warnung: this is legal, if i in std(i,p)
3415        // is homogeneous, but p not
3416        w=NULL;
3417      }
3418      else
3419      {
3420        w=ivCopy(w);
3421        hom=isHomog;
3422      }
3423    }
3424    BITSET save1;
3425    SI_SAVE_OPT1(save1);
3426    si_opt_1|=Sy_bit(OPT_SB_1);
3427    /* ii1 appears to be the position of the first element of il that
3428       does not belong to the old SB ideal */
3429    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii1);
3430    SI_RESTORE_OPT1(save1);
3431    idDelete(&i1);
3432    idSkipZeroes(result);
3433    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3434    res->data = (char *)result;
3435  }
3436  else /*IDEAL/MODULE*/
3437  {
3438    i0=(ideal)v->CopyD();
3439    i1=idSimpleAdd(i1,i0); //
3440    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3441    idDelete(&i0);
3442    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3443    tHomog hom=testHomog;
3444
3445    if (w!=NULL)
3446    {
3447      if (!idTestHomModule(i1,currRing->qideal,w))
3448      {
3449        // no warnung: this is legal, if i in std(i,p)
3450        // is homogeneous, but p not
3451        w=NULL;
3452        hom=isNotHomog;
3453      }
3454      else
3455      {
3456        w=ivCopy(w);
3457        hom=isHomog;
3458      }
3459    }
3460    BITSET save1;
3461    SI_SAVE_OPT1(save1);
3462    si_opt_1|=Sy_bit(OPT_SB_1);
3463    /* ii1 appears to be the position of the first element of i1 that
3464     does not belong to the old SB ideal */
3465    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii1);
3466    SI_RESTORE_OPT1(save1);
3467    idDelete(&i1);
3468    idSkipZeroes(result);
3469    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3470    res->data = (char *)result;
3471  }
3472  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3473  return FALSE;
3474}
3475static BOOLEAN jjSYZ_2(leftv res, leftv u, leftv v)
3476{
3477  // see jjSYZYGY
3478  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3479  intvec *w=NULL;
3480  tHomog hom=testHomog;
3481  ideal I=(ideal)u->Data();
3482  GbVariant alg=syGetAlgorithm((char*)v->Data(),currRing,I);
3483  if (ww!=NULL)
3484  {
3485    if (idTestHomModule(I,currRing->qideal,ww))
3486    {
3487      w=ivCopy(ww);
3488      int add_row_shift=w->min_in();
3489      (*w)-=add_row_shift;
3490      hom=isHomog;
3491    }
3492    else
3493    {
3494      //WarnS("wrong weights");
3495      delete ww; ww=NULL;
3496      hom=testHomog;
3497    }
3498  }
3499  else
3500  {
3501    if (u->Typ()==IDEAL_CMD)
3502      if (idHomIdeal(I,currRing->qideal))
3503        hom=isHomog;
3504  }
3505  ideal S=idSyzygies(I,hom,&w,TRUE,FALSE,NULL,alg);
3506  if (w!=NULL) delete w;
3507  res->data = (char *)S;
3508  if (hom==isHomog)
3509  {
3510    int vl=S->rank;
3511    intvec *vv=new intvec(vl);
3512    if ((u->Typ()==IDEAL_CMD)||(ww==NULL))
3513    {
3514      for(int i=0;i<vl;i++)
3515      {
3516        if (I->m[i]!=NULL)
3517          (*vv)[i]=p_Deg(I->m[i],currRing);
3518      }
3519    }
3520    else
3521    {
3522      p_SetModDeg(ww, currRing);
3523      for(int i=0;i<vl;i++)
3524      {
3525        if (I->m[i]!=NULL)
3526          (*vv)[i]=currRing->pFDeg(I->m[i],currRing);
3527      }
3528      p_SetModDeg(NULL, currRing);
3529    }
3530    if (idTestHomModule(S,currRing->qideal,vv))
3531      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
3532    else
3533      delete vv;
3534  }
3535  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
3536  return FALSE;
3537}
3538static BOOLEAN jjTENSOR(leftv res, leftv u, leftv v)
3539{
3540  ideal A=(ideal)u->Data();
3541  ideal B=(ideal)v->Data();
3542  res->data = (char *)sm_Tensor(A,B,currRing);
3543  return FALSE;
3544}
3545static BOOLEAN jjTENSOR_Ma(leftv res, leftv u, leftv v)
3546{
3547  sleftv tmp_u,tmp_v,tmp_res;
3548  int index=iiTestConvert(MATRIX_CMD,SMATRIX_CMD,dConvertTypes);
3549  iiConvert(MATRIX_CMD,SMATRIX_CMD,index,u,&tmp_u,dConvertTypes);
3550  iiConvert(MATRIX_CMD,SMATRIX_CMD,index,v,&tmp_v,dConvertTypes);
3551  tmp_res.Init();
3552  tmp_res.rtyp=SMATRIX_CMD;
3553  BOOLEAN bo=jjTENSOR(&tmp_res,&tmp_u,&tmp_v);
3554  if (!bo)
3555  {
3556    index=iiTestConvert(SMATRIX_CMD,MATRIX_CMD,dConvertTypes);
3557    iiConvert(SMATRIX_CMD,MATRIX_CMD,index,&tmp_res,res,dConvertTypes);
3558  }
3559  tmp_u.CleanUp();
3560  tmp_v.CleanUp();
3561  tmp_res.CleanUp();
3562  return bo;
3563}
3564static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3565{
3566  idhdl h=(idhdl)u->data;
3567  int i=(int)(long)v->Data();
3568  if ((0<i) && (i<=IDRING(h)->N))
3569    res->data=omStrDup(IDRING(h)->names[i-1]);
3570  else
3571  {
3572    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3573    return TRUE;
3574  }
3575  return FALSE;
3576}
3577static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3578{
3579// input: u: a list with links of type
3580//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3581//        v: timeout for select in milliseconds
3582//           or 0 for polling
3583// returns: ERROR (via Werror): timeout negative
3584//           -1: the read state of all links is eof
3585//            0: timeout (or polling): none ready
3586//           i>0: (at least) L[i] is ready
3587  lists Lforks = (lists)u->Data();
3588  int t = (int)(long)v->Data();
3589  if(t < 0)
3590  {
3591    WerrorS("negative timeout"); return TRUE;
3592  }
3593  int i = slStatusSsiL(Lforks, t*1000);
3594  if(i == -2) /* error */
3595  {
3596    return TRUE;
3597  }
3598  res->data = (void*)(long)i;
3599  return FALSE;
3600}
3601static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3602{
3603// input: u: a list with links of type
3604//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3605//        v: timeout for select in milliseconds
3606//           or 0 for polling
3607// returns: ERROR (via Werror): timeout negative
3608//           -1: the read state of all links is eof
3609//           0: timeout (or polling): none ready
3610//           1: all links are ready
3611//              (caution: at least one is ready, but some maybe dead)
3612  lists Lforks = (lists)u->CopyD();
3613  int timeout = 1000*(int)(long)v->Data();
3614  if(timeout < 0)
3615  {
3616    WerrorS("negative timeout"); return TRUE;
3617  }
3618  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3619  int i;
3620  int ret = -1;
3621  for(unsigned nfinished = 0; nfinished < ((unsigned)Lforks->nr)+1; nfinished++)
3622  {
3623    i = slStatusSsiL(Lforks, timeout);
3624    if(i > 0) /* Lforks[i] is ready */
3625    {
3626      ret = 1;
3627      Lforks->m[i-1].CleanUp();
3628      Lforks->m[i-1].rtyp=DEF_CMD;
3629      Lforks->m[i-1].data=NULL;
3630      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3631    }
3632    else /* terminate the for loop */
3633    {
3634      if(i == -2) /* error */
3635      {
3636        return TRUE;
3637      }
3638      if(i == 0) /* timeout */
3639      {
3640        ret = 0;
3641      }
3642      break;
3643    }
3644  }
3645  Lforks->Clean();
3646  res->data = (void*)(long)ret;
3647  return FALSE;
3648}
3649static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3650{
3651  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3652  return FALSE;
3653}
3654#define jjWRONG2 (proc2)jjWRONG
3655#define jjWRONG3 (proc3)jjWRONG
3656static BOOLEAN jjWRONG(leftv, leftv)
3657{
3658  return TRUE;
3659}
3660
3661/*=================== operations with 1 arg.: static proc =================*/
3662/* must be ordered: first operations for chars (infix ops),
3663 * then alphabetically */
3664
3665static BOOLEAN jjDUMMY(leftv res, leftv u)
3666{
3667//  res->data = (char *)u->CopyD();
3668// also copy attributes:
3669  res->Copy(u);
3670  return FALSE;
3671}
3672static BOOLEAN jjNULL(leftv, leftv)
3673{
3674  return FALSE;
3675}
3676//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3677//{
3678//  res->data = (char *)((int)(long)u->Data()+1);
3679//  return FALSE;
3680//}
3681//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3682//{
3683//  res->data = (char *)((int)(long)u->Data()-1);
3684//  return FALSE;
3685//}
3686static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3687{
3688  if (IDTYP((idhdl)u->data)==INT_CMD)
3689  {
3690    int i=IDINT((idhdl)u->data);
3691    if (iiOp==PLUSPLUS) i++;
3692    else                i--;
3693    IDDATA((idhdl)u->data)=(char *)(long)i;
3694    return FALSE;
3695  }
3696  return TRUE;
3697}
3698static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3699{
3700  number n=(number)u->CopyD(BIGINT_CMD);
3701  n=n_InpNeg(n,coeffs_BIGINT);
3702  res->data = (char *)n;
3703  return FALSE;
3704}
3705static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3706{
3707  res->data = (char *)(-(long)u->Data());
3708  return FALSE;
3709}
3710static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3711{
3712  number n=(number)u->CopyD(NUMBER_CMD);
3713  n=nInpNeg(n);
3714  res->data = (char *)n;
3715  return FALSE;
3716}
3717static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3718{
3719  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3720  return FALSE;
3721}
3722static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3723{
3724  poly m1=pISet(-1);
3725  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3726  return FALSE;
3727}
3728static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3729{
3730  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3731  (*iv)*=(-1);
3732  res->data = (char *)iv;
3733  return FALSE;
3734}
3735static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3736{
3737  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3738  (*bim)*=(-1);
3739  res->data = (char *)bim;
3740  return FALSE;
3741}
3742// dummy for python_module.so and similiar
3743static BOOLEAN jjSetRing(leftv, leftv u)
3744{
3745  if (u->rtyp==IDHDL) rSetHdl((idhdl)u->data);
3746  else
3747  {
3748    ring r=(ring)u->Data();
3749    idhdl h=rFindHdl(r,NULL);
3750    if (h==NULL)
3751    {
3752      char name_buffer[100];
3753      STATIC_VAR int ending=1000000;
3754      ending++;
3755      sprintf(name_buffer, "PYTHON_RING_VAR%d",ending);
3756      h=enterid(name_buffer,0,RING_CMD,&IDROOT);
3757      IDRING(h)=r;
3758      r->ref++;
3759    }
3760    rSetHdl(h);
3761  }
3762  return FALSE;
3763}
3764static BOOLEAN jjPROC1(leftv res, leftv u)
3765{
3766  return jjPROC(res,u,NULL);
3767}
3768static BOOLEAN jjBAREISS(leftv res, leftv v)
3769{
3770  //matrix m=(matrix)v->Data();
3771  //lists l=mpBareiss(m,FALSE);
3772  intvec *iv;
3773  ideal m;
3774  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3775  lists l=(lists)omAllocBin(slists_bin);
3776  l->Init(2);
3777  l->m[0].rtyp=MODUL_CMD;
3778  l->m[1].rtyp=INTVEC_CMD;
3779  l->m[0].data=(void *)m;
3780  l->m[1].data=(void *)iv;
3781  res->data = (char *)l;
3782  return FALSE;
3783}
3784//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3785//{
3786//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3787//  ivTriangMat(m);
3788//  res->data = (char *)m;
3789//  return FALSE;
3790//}
3791static BOOLEAN jjBAREISS_BIM(leftv res, leftv v)
3792{
3793  bigintmat *b=(bigintmat*)v->CopyD(BIGINTMAT_CMD);
3794  b->hnf();
3795  res->data=(char*)b;
3796  return FALSE;
3797}
3798static BOOLEAN jjBI2N(leftv res, leftv u)
3799{
3800  BOOLEAN bo=FALSE;
3801  number n=(number)u->CopyD();
3802  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3803  if (nMap!=NULL)
3804    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3805  else
3806  {
3807    Werror("cannot convert bigint to cring %s", nCoeffName(currRing->cf));
3808    bo=TRUE;
3809  }
3810  n_Delete(&n,coeffs_BIGINT);
3811  return bo;
3812}
3813static BOOLEAN jjBI2IM(leftv res, leftv u)
3814{
3815  bigintmat *b=(bigintmat*)u->Data();
3816  res->data=(void *)bim2iv(b);
3817  return FALSE;
3818}
3819static BOOLEAN jjBI2P(leftv res, leftv u)
3820{
3821  sleftv tmp;
3822  BOOLEAN bo=jjBI2N(&tmp,u);
3823  if (!bo)
3824  {
3825    number n=(number) tmp.data;
3826    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3827    else
3828    {
3829      res->data=(void *)pNSet(n);
3830    }
3831  }
3832  return bo;
3833}
3834static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3835{
3836  return iiExprArithM(res,u,iiOp);
3837}
3838static BOOLEAN jjCHAR(leftv res, leftv v)
3839{
3840  res->data = (char *)(long)rChar((ring)v->Data());
3841  return FALSE;
3842}
3843static BOOLEAN jjCOLS(leftv res, leftv v)
3844{
3845  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3846  return FALSE;
3847}
3848static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3849{
3850  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3851  return FALSE;
3852}
3853static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3854{
3855  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3856  return FALSE;
3857}
3858static BOOLEAN jjCONTENT(leftv res, leftv v)
3859{
3860  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3861  poly p=(poly)v->CopyD(POLY_CMD);
3862  if (p!=NULL) p_Cleardenom(p, currRing);
3863  res->data = (char *)p;
3864  return FALSE;
3865}
3866static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3867{
3868  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3869  return FALSE;
3870}
3871static BOOLEAN jjCOUNT_BIM(leftv res, leftv v)
3872{
3873  bigintmat* aa= (bigintmat *)v->Data();
3874  res->data = (char *)(long)(aa->rows()*aa->cols());
3875  return FALSE;
3876}
3877static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3878{
3879  res->data = (char *)(long)nSize((number)v->Data());
3880  return FALSE;
3881}
3882static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3883{
3884  lists l=(lists)v->Data();
3885  res->data = (char *)(long)(lSize(l)+1);
3886  return FALSE;
3887}
3888static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3889{
3890  matrix m=(matrix)v->Data();
3891  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3892  return FALSE;
3893}
3894static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3895{
3896  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3897  return FALSE;
3898}
3899static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3900{
3901  ring r=(ring)v->Data();
3902  int elems=-1;
3903  if (rField_is_Zp(r))      elems=r->cf->ch;
3904  else if (rField_is_GF(r)) elems=r->cf->m_nfCharQ;
3905  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3906  {
3907    extern int ipower ( int b, int n ); /* factory/cf_util */
3908    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3909  }
3910  res->data = (char *)(long)elems;
3911  return FALSE;
3912}
3913static BOOLEAN jjDEG(leftv res, leftv v)
3914{
3915  int dummy;
3916  poly p=(poly)v->Data();
3917  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3918  else res->data=(char *)-1;
3919  return FALSE;
3920}
3921static BOOLEAN jjDEG_M(leftv res, leftv u)
3922{
3923  ideal I=(ideal)u->Data();
3924  int d=-1;
3925  int dummy;
3926  int i;
3927  for(i=IDELEMS(I)-1;i>=0;i--)
3928    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3929  res->data = (char *)(long)d;
3930  return FALSE;
3931}
3932static BOOLEAN jjDEGREE(leftv res, leftv v)
3933{
3934  SPrintStart();
3935#ifdef HAVE_RINGS
3936  if (rField_is_Z(currRing))
3937  {
3938    PrintS("// NOTE: computation of degree is being performed for\n");
3939    PrintS("//       generic fibre, that is, over Q\n");
3940  }
3941#endif
3942  assumeStdFlag(v);
3943  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3944  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3945  char *s=SPrintEnd();
3946  int l=strlen(s)-1;
3947  s[l]='\0';
3948  res->data=(void*)s;
3949  return FALSE;
3950}
3951static BOOLEAN jjDEFINED(leftv res, leftv v)
3952{
3953  if ((v->rtyp==IDHDL)
3954  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3955  {
3956    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3957  }
3958  else if (v->rtyp!=0) res->data=(void *)(-1);
3959  return FALSE;
3960}
3961
3962/// Return the denominator of the input number
3963static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3964{
3965  number n = reinterpret_cast<number>(v->CopyD());
3966  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing->cf));
3967  n_Delete(&n,currRing);
3968  return FALSE;
3969}
3970
3971/// Return the numerator of the input number
3972static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3973{
3974  number n = reinterpret_cast<number>(v->CopyD());
3975  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing->cf));
3976  n_Delete(&n,currRing);
3977  return FALSE;
3978}
3979
3980static BOOLEAN jjDET(leftv res, leftv v)
3981{
3982  matrix m=(matrix)v->Data();
3983  res ->data = mp_Det(m,currRing);
3984  return FALSE;
3985}
3986static BOOLEAN jjDET_BI(leftv res, leftv v)
3987{
3988  bigintmat * m=(bigintmat*)v->Data();
3989  int i,j;
3990  i=m->rows();j=m->cols();
3991  if(i==j)
3992    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3993  else
3994  {
3995    Werror("det of %d x %d bigintmat",i,j);
3996    return TRUE;
3997  }
3998  return FALSE;
3999}
4000#ifdef SINGULAR_4_2
4001static BOOLEAN jjDET_N2(leftv res, leftv v)
4002{
4003  bigintmat * m=(bigintmat*)v->Data();
4004  number2 r=(number2)omAlloc0(sizeof(*r));
4005  int i,j;
4006  i=m->rows();j=m->cols();
4007  if(i==j)
4008  {
4009    r->n=m->det();
4010    r->cf=m->basecoeffs();
4011  }
4012  else
4013  {
4014    omFreeSize(r,sizeof(*r));
4015    Werror("det of %d x %d cmatrix",i,j);
4016    return TRUE;
4017  }
4018  res->data=(void*)r;
4019  return FALSE;
4020}
4021#endif
4022static BOOLEAN jjDET_I(leftv res, leftv v)
4023{
4024  intvec * m=(intvec*)v->Data();
4025  int i,j;
4026  i=m->rows();j=m->cols();
4027  if(i==j)
4028    res->data = (char *)(long)singclap_det_i(m,currRing);
4029  else
4030  {
4031    Werror("det of %d x %d intmat",i,j);
4032    return TRUE;
4033  }
4034  return FALSE;
4035}
4036static BOOLEAN jjDET_S(leftv res, leftv v)
4037{
4038  ideal I=(ideal)v->Data();
4039  res->data=(char*)sm_Det(I,currRing);
4040  return FALSE;
4041}
4042static BOOLEAN jjDIM(leftv res, leftv v)
4043{
4044  assumeStdFlag(v);
4045  if (rHasMixedOrdering(currRing))
4046  {
4047     Warn("dim(%s) may be wrong because the mixed monomial ordering",v->Name());
4048  }
4049  res->data = (char *)(long)scDimIntRing((ideal)(v->Data()),currRing->qideal);
4050  return FALSE;
4051}
4052static BOOLEAN jjDUMP(leftv, leftv v)
4053{
4054  si_link l = (si_link)v->Data();
4055  if (slDump(l))
4056  {
4057    const char *s;
4058    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4059    else                            s=sNoName_fe;
4060    Werror("cannot dump to `%s`",s);
4061    return TRUE;
4062  }
4063  else
4064    return FALSE;
4065}
4066static BOOLEAN jjE(leftv res, leftv v)
4067{
4068  res->data = (char *)pOne();
4069  int co=(int)(long)v->Data();
4070  if (co>0)
4071  {
4072    pSetComp((poly)res->data,co);
4073    pSetm((poly)res->data);
4074  }
4075  else WerrorS("argument of gen must be positive");
4076  return (co<=0);
4077}
4078static BOOLEAN jjEXECUTE(leftv, leftv v)
4079{
4080  char * d = (char *)v->Data();
4081  char * s = (char *)omAlloc(strlen(d) + 13);
4082  strcpy( s, (char *)d);
4083  strcat( s, "\n;RETURN();\n");
4084  newBuffer(s,BT_execute);
4085  return yyparse();
4086}
4087static BOOLEAN jjFACSTD(leftv res, leftv v)
4088{
4089  lists L=(lists)omAllocBin(slists_bin);
4090  if (currRing->cf->convSingNFactoryN!=ndConvSingNFactoryN) /* conversion to factory*/
4091  {
4092    ideal_list p,h;
4093    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4094    if (h==NULL)
4095    {
4096      L->Init(1);
4097      L->m[0].data=(char *)idInit(1);
4098      L->m[0].rtyp=IDEAL_CMD;
4099    }
4100    else
4101    {
4102      p=h;
4103      int l=0;
4104      while (p!=NULL) { p=p->next;l++; }
4105      L->Init(l);
4106      l=0;
4107      while(h!=NULL)
4108      {
4109        L->m[l].data=(char *)h->d;
4110        L->m[l].rtyp=IDEAL_CMD;
4111        p=h->next;
4112        omFreeSize(h,sizeof(*h));
4113        h=p;
4114        l++;
4115      }
4116    }
4117  }
4118  else
4119  {
4120    WarnS("no factorization implemented");
4121    L->Init(1);
4122    iiExprArith1(&(L->m[0]),v,STD_CMD);
4123  }
4124  res->data=(void *)L;
4125  return FALSE;
4126}
4127static BOOLEAN jjFAC_P(leftv res, leftv u)
4128{
4129  intvec *v=NULL;
4130  singclap_factorize_retry=0;
4131  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4132  if (f==NULL) return TRUE;
4133  ivTest(v);
4134  lists l=(lists)omAllocBin(slists_bin);
4135  l->Init(2);
4136  l->m[0].rtyp=IDEAL_CMD;
4137  l->m[0].data=(void *)f;
4138  l->m[1].rtyp=INTVEC_CMD;
4139  l->m[1].data=(void *)v;
4140  res->data=(void *)l;
4141  return FALSE;
4142}
4143static BOOLEAN jjGETDUMP(leftv, leftv v)
4144{
4145  si_link l = (si_link)v->Data();
4146  if (slGetDump(l))
4147  {
4148    const char *s;
4149    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4150    else                            s=sNoName_fe;
4151    Werror("cannot get dump from `%s`",s);
4152    return TRUE;
4153  }
4154  else
4155    return FALSE;
4156}
4157static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4158{
4159  assumeStdFlag(v);
4160  ideal I=(ideal)v->Data();
4161  res->data=(void *)iiHighCorner(I,0);
4162  return FALSE;
4163}
4164static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4165{
4166  assumeStdFlag(v);
4167  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4168  BOOLEAN delete_w=FALSE;
4169  ideal I=(ideal)v->Data();
4170  int i;
4171  poly p=NULL,po=NULL;
4172  int rk=id_RankFreeModule(I,currRing);
4173  if (w==NULL)
4174  {
4175    w = new intvec(rk);
4176    delete_w=TRUE;
4177  }
4178  for(i=rk;i>0;i--)
4179  {
4180    p=iiHighCorner(I,i);
4181    if (p==NULL)
4182    {
4183      WerrorS("module must be zero-dimensional");
4184      if (delete_w) delete w;
4185      return TRUE;
4186    }
4187    if (po==NULL)
4188    {
4189      po=p;
4190    }
4191    else
4192    {
4193      // now po!=NULL, p!=NULL
4194      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4195      if (d==0)
4196        d=pLmCmp(po,p);
4197      if (d > 0)
4198      {
4199        pDelete(&p);
4200      }
4201      else // (d < 0)
4202      {
4203        pDelete(&po); po=p;
4204      }
4205    }
4206  }
4207  if (delete_w) delete w;
4208  res->data=(void *)po;
4209  return FALSE;
4210}
4211static BOOLEAN jjHILBERT(leftv, leftv v)
4212{
4213#ifdef HAVE_RINGS
4214  if (rField_is_Z(currRing))
4215  {
4216    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
4217    PrintS("//       performed for generic fibre, that is, over Q\n");
4218  }
4219#endif
4220  assumeStdFlag(v);
4221  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4222  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4223  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4224  return FALSE;
4225}
4226static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4227{
4228#ifdef HAVE_RINGS
4229  if (rField_is_Z(currRing))
4230  {
4231    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
4232    PrintS("//       performed for generic fibre, that is, over Q\n");
4233  }
4234#endif
4235  res->data=(void *)hSecondSeries((intvec *)v->Data());
4236  return FALSE;
4237}
4238static BOOLEAN jjHOMOG1(leftv res, leftv v)
4239{
4240  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4241  ideal v_id=(ideal)v->Data();
4242  if (w==NULL)
4243  {
4244    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4245    if (res->data!=NULL)
4246    {
4247      if (v->rtyp==IDHDL)
4248      {
4249        char *s_isHomog=omStrDup("isHomog");
4250        if (v->e==NULL)
4251          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4252        else
4253          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4254      }
4255      else if (w!=NULL) delete w;
4256    } // if res->data==NULL then w==NULL
4257  }
4258  else
4259  {
4260    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4261    if((res->data==NULL) && (v->rtyp==IDHDL))
4262    {
4263      if (v->e==NULL)
4264        atKill((idhdl)(v->data),"isHomog");
4265      else
4266        atKill((idhdl)(v->LData()),"isHomog");
4267    }
4268  }
4269  return FALSE;
4270}
4271static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4272{
4273#ifdef HAVE_SHIFTBBA
4274  if (currRing->isLPring)
4275  {
4276    int deg = (int)(long)v->Data();
4277    if (deg > currRing->N/currRing->isLPring) {
4278      WerrorS("degree bound of Letterplace ring is to small");
4279      return TRUE;
4280    }
4281  }
4282#endif
4283  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4284  setFlag(res,FLAG_STD);
4285  return FALSE;
4286}
4287static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4288{
4289  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4290  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4291  if (IDELEMS((ideal)mat)==0)
4292  {
4293    idDelete((ideal *)&mat);
4294    mat=(matrix)idInit(1,1);
4295  }
4296  else
4297  {
4298    MATROWS(mat)=1;
4299    mat->rank=1;
4300    idTest((ideal)mat);
4301  }
4302  res->data=(char *)mat;
4303  return FALSE;
4304}
4305static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4306{
4307  map m=(map)v->CopyD(MAP_CMD);
4308  omFree((ADDRESS)m->preimage);
4309  m->preimage=NULL;
4310  ideal I=(ideal)m;
4311  I->rank=1;
4312  res->data=(char *)I;
4313  return FALSE;
4314}
4315static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4316{
4317  if (currRing!=NULL)
4318  {
4319    ring q=(ring)v->Data();
4320    if (rSamePolyRep(currRing, q))
4321    {
4322      if (q->qideal==NULL)
4323        res->data=(char *)idInit(1,1);
4324      else
4325        res->data=(char *)idCopy(q->qideal);
4326      return FALSE;
4327    }
4328  }
4329  WerrorS("can only get ideal from identical qring");
4330  return TRUE;
4331}
4332static BOOLEAN jjIm2Iv(leftv res, leftv v)
4333{
4334  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4335  iv->makeVector();
4336  res->data = iv;
4337  return FALSE;
4338}
4339static BOOLEAN jjIMPART(leftv res, leftv v)
4340{
4341  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4342  return FALSE;
4343}
4344static BOOLEAN jjINDEPSET(leftv res, leftv v)
4345{
4346  assumeStdFlag(v);
4347  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4348  return FALSE;
4349}
4350static BOOLEAN jjINTERRED(leftv res, leftv v)
4351{
4352  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4353#ifdef HAVE_RINGS
4354  if(rField_is_Ring(currRing))
4355    WarnS("interred: this command is experimental over the integers");
4356#endif
4357  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4358  res->data = result;
4359  return FALSE;
4360}
4361static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4362{
4363  res->data = (char *)(long)pVar((poly)v->Data());
4364  return FALSE;
4365}
4366static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4367{
4368  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4369                                                            currRing->N)+1);
4370  return FALSE;
4371}
4372static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4373{
4374  res->data = (char *)0;
4375  return FALSE;
4376}
4377static BOOLEAN jjJACOB_P(leftv res, leftv v)
4378{
4379  ideal i=idInit(currRing->N,1);
4380  int k;
4381  poly p=(poly)(v->Data());
4382  for (k=currRing->N;k>0;k--)
4383  {
4384    i->m[k-1]=pDiff(p,k);
4385  }
4386  res->data = (char *)i;
4387  return FALSE;
4388}
4389static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4390{
4391  if (!nCoeff_is_transExt(currRing->cf))
4392  {
4393    WerrorS("differentiation not defined in the coefficient ring");
4394    return TRUE;
4395  }
4396  number n = (number) u->Data();
4397  number k = (number) v->Data();
4398  res->data = ntDiff(n,k,currRing->cf);
4399  return FALSE;
4400}
4401/*2
4402 * compute Jacobi matrix of a module/matrix
4403 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4404 * where Mt := transpose(M)
4405 * Note that this is consistent with the current conventions for jacob in Singular,
4406 * whereas M2 computes its transposed.
4407 */
4408static BOOLEAN jjJACOB_M(leftv res, leftv a)
4409{
4410  ideal id = (ideal)a->Data();
4411  id = id_Transp(id,currRing);
4412  int W = IDELEMS(id);
4413
4414  ideal result = idInit(W * currRing->N, id->rank);
4415  poly *p = result->m;
4416
4417  for( int v = 1; v <= currRing->N; v++ )
4418  {
4419    poly* q = id->m;
4420    for( int i = 0; i < W; i++, p++, q++ )
4421      *p = pDiff( *q, v );
4422  }
4423  idDelete(&id);
4424
4425  res->data = (char *)result;
4426  return FALSE;
4427}
4428
4429static BOOLEAN jjKBASE(leftv res, leftv v)
4430{
4431  assumeStdFlag(v);
4432  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4433  return FALSE;
4434}
4435static BOOLEAN jjL2R(leftv res, leftv v)
4436{
4437  res->data=(char *)syConvList((lists)v->Data());
4438  if (res->data != NULL)
4439    return FALSE;
4440  else
4441    return TRUE;
4442}
4443static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4444{
4445  poly p=(poly)v->Data();
4446  if (p==NULL)
4447  {
4448    res->data=(char *)nInit(0);
4449  }
4450  else
4451  {
4452    nNormalize(pGetCoeff(p));
4453    res->data=(char *)nCopy(pGetCoeff(p));
4454  }
4455  return FALSE;
4456}
4457static BOOLEAN jjLEADEXP(leftv res, leftv v)
4458{
4459  poly p=(poly)v->Data();
4460  int s=currRing->N;
4461  if (v->Typ()==VECTOR_CMD) s++;
4462  intvec *iv=new intvec(s);
4463  if (p!=NULL)
4464  {
4465    for(int i = currRing->N;i;i--)
4466    {
4467      (*iv)[i-1]=pGetExp(p,i);
4468    }
4469    if (s!=currRing->N)
4470      (*iv)[currRing->N]=pGetComp(p);
4471  }
4472  res->data=(char *)iv;
4473  return FALSE;
4474}
4475static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4476{
4477  poly p=(poly)v->Data();
4478  if (p == NULL)
4479  {
4480    res->data = (char*) NULL;
4481  }
4482  else
4483  {
4484    poly lm = pLmInit(p);
4485    pSetCoeff0(lm, nInit(1));
4486    res->data = (char*) lm;
4487  }
4488  return FALSE;
4489}
4490static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4491{
4492  return jjLOAD((char*)v->Data(),FALSE);
4493}
4494static BOOLEAN jjLISTRING(leftv res, leftv v)
4495{
4496  lists l=(lists)v->Data();
4497  long mm=(long)atGet(v,"maxExp",INT_CMD);
4498  if (mm==0) mm=0x7fff;
4499  int isLetterplace=(int)(long)atGet(v,"isLetterplaceRing",INT_CMD);
4500  ring r=rCompose(l,TRUE,mm,isLetterplace);
4501  res->data=(char *)r;
4502  return (r==NULL);
4503}
4504static BOOLEAN jjPFAC1(leftv res, leftv v)
4505{
4506  /* call method jjPFAC2 with second argument = 0 (meaning that no
4507     valid bound for the prime factors has been given) */
4508  sleftv tmp;
4509  memset(&tmp, 0, sizeof(tmp));
4510  tmp.rtyp = INT_CMD;
4511  return jjPFAC2(res, v, &tmp);
4512}
4513static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4514{
4515  /* computes the LU-decomposition of a matrix M;
4516     i.e., M = P * L * U, where
4517        - P is a row permutation matrix,
4518        - L is in lower triangular form,
4519        - U is in upper row echelon form
4520     Then, we also have P * M = L * U.
4521     A list [P, L, U] is returned. */
4522  matrix mat = (const matrix)v->Data();
4523  if (!idIsConstant((ideal)mat))
4524  {
4525    WerrorS("matrix must be constant");
4526    return TRUE;
4527  }
4528  matrix pMat;
4529  matrix lMat;
4530  matrix uMat;
4531
4532  luDecomp(mat, pMat, lMat, uMat);
4533
4534  lists ll = (lists)omAllocBin(slists_bin);
4535  ll->Init(3);
4536  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4537  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4538  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4539  res->data=(char*)ll;
4540
4541  return FALSE;
4542}
4543static BOOLEAN jjMEMORY(leftv res, leftv v)
4544{
4545  // clean out "_":
4546  sLastPrinted.CleanUp();
4547  memset(&sLastPrinted,0,sizeof(sleftv));
4548  // collect all info:
4549  omUpdateInfo();
4550  switch(((int)(long)v->Data()))
4551  {
4552  case 0:
4553    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4554    break;
4555  case 1:
4556    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4557    break;
4558  case 2:
4559    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4560    break;
4561  default:
4562    omPrintStats(stdout);
4563    omPrintInfo(stdout);
4564    omPrintBinStats(stdout);
4565    res->data = (char *)0;
4566    res->rtyp = NONE;
4567  }
4568  return FALSE;
4569  res->data = (char *)0;
4570  return FALSE;
4571}
4572//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4573//{
4574//  return jjMONITOR2(res,v,NULL);
4575//}
4576static BOOLEAN jjMSTD(leftv res, leftv v)
4577{
4578  int t=v->Typ();
4579  ideal r,m;
4580  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4581  lists l=(lists)omAllocBin(slists_bin);
4582  l->Init(2);
4583  l->m[0].rtyp=t;
4584  l->m[0].data=(char *)r;
4585  setFlag(&(l->m[0]),FLAG_STD);
4586  l->m[1].rtyp=t;
4587  l->m[1].data=(char *)m;
4588  res->data=(char *)l;
4589  return FALSE;
4590}
4591static BOOLEAN jjMULT(leftv res, leftv v)
4592{
4593  assumeStdFlag(v);
4594  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4595  return FALSE;
4596}
4597static BOOLEAN jjMINRES_R(leftv res, leftv v)
4598{
4599  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4600
4601  syStrategy tmp=(syStrategy)v->Data();
4602  tmp = syMinimize(tmp); // enrich itself!
4603
4604  res->data=(char *)tmp;
4605
4606  if (weights!=NULL)
4607    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4608
4609  return FALSE;
4610}
4611static BOOLEAN jjN2BI(leftv res, leftv v)
4612{
4613  number n,i; i=(number)v->Data();
4614  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4615  if (nMap!=NULL)
4616    n=nMap(i,currRing->cf,coeffs_BIGINT);
4617  else goto err;
4618  res->data=(void *)n;
4619  return FALSE;
4620err:
4621  WerrorS("cannot convert to bigint"); return TRUE;
4622}
4623static BOOLEAN jjNAMEOF(leftv res, leftv v)
4624{
4625  if ((v->rtyp==IDHDL)||(v->rtyp==ALIAS_CMD))
4626    res->data=omStrDup(v->name);
4627  else if (v->name==NULL)
4628    res->data=omStrDup("");
4629  else
4630  {
4631    res->data = (char *)v->name;
4632    v->name=NULL;
4633  }
4634  return FALSE;
4635}
4636static BOOLEAN jjNAMES(leftv res, leftv v)
4637{
4638  res->data=ipNameList(((ring)v->Data())->idroot);
4639  return FALSE;
4640}
4641static BOOLEAN jjNAMES_I(leftv res, leftv v)
4642{
4643  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4644  return FALSE;
4645}
4646static BOOLEAN jjNOT(leftv res, leftv v)
4647{
4648  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4649  return FALSE;
4650}
4651static BOOLEAN jjNVARS(leftv res, leftv v)
4652{
4653  res->data = (char *)(long)(((ring)(v->Data()))->N);
4654  return FALSE;
4655}
4656static BOOLEAN jjOpenClose(leftv, leftv v)
4657{
4658  si_link l=(si_link)v->Data();
4659  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4660  else { slPrepClose(l); return slClose(l);}
4661}
4662static BOOLEAN jjORD(leftv res, leftv v)
4663{
4664  poly p=(poly)v->Data();
4665  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4666  return FALSE;
4667}
4668static BOOLEAN jjPAR1(leftv res, leftv v)
4669{
4670  int i=(int)(long)v->Data();
4671  int p=0;
4672  p=rPar(currRing);
4673  if ((0<i) && (i<=p))
4674  {
4675    res->data=(char *)n_Param(i,currRing);
4676  }
4677  else
4678  {
4679    Werror("par number %d out of range 1..%d",i,p);
4680    return TRUE;
4681  }
4682  return FALSE;
4683}
4684static BOOLEAN jjPARDEG(leftv res, leftv v)
4685{
4686  number nn=(number)v->Data();
4687  res->data = (char *)(long)n_ParDeg(nn, currRing->cf);
4688  return FALSE;
4689}
4690static BOOLEAN jjPARSTR1(leftv res, leftv v)
4691{
4692  if (currRing==NULL)
4693  {
4694    WerrorS("no ring active (1)");
4695    return TRUE;
4696  }
4697  int i=(int)(long)v->Data();
4698  int p=0;
4699  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4700    res->data=omStrDup(rParameter(currRing)[i-1]);
4701  else
4702  {
4703    Werror("par number %d out of range 1..%d",i,p);
4704    return TRUE;
4705  }
4706  return FALSE;
4707}
4708static BOOLEAN jjP2BI(leftv res, leftv v)
4709{
4710  poly p=(poly)v->Data();
4711  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4712  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4713  {
4714    WerrorS("poly must be constant");
4715    return TRUE;
4716  }
4717  number i=pGetCoeff(p);
4718  number n;
4719  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4720  if (nMap!=NULL)
4721    n=nMap(i,currRing->cf,coeffs_BIGINT);
4722  else goto err;
4723  res->data=(void *)n;
4724  return FALSE;
4725err:
4726  WerrorS("cannot convert to bigint"); return TRUE;
4727}
4728static BOOLEAN jjP2I(leftv res, leftv v)
4729{
4730  poly p=(poly)v->Data();
4731  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4732  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4733  {
4734    WerrorS("poly must be constant");
4735    return TRUE;
4736  }
4737  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4738  return FALSE;
4739}
4740static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4741{
4742  map mapping=(map)v->Data();
4743  syMake(res,omStrDup(mapping->preimage));
4744  return FALSE;
4745}
4746static BOOLEAN jjPRIME(leftv res, leftv v)
4747{
4748  int i = IsPrime((int)(long)(v->Data()));
4749  res->data = (char *)(long)(i > 1 ? i : 2);
4750  return FALSE;
4751}
4752static BOOLEAN jjPRUNE(leftv res, leftv v)
4753{
4754  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4755  ideal v_id=(ideal)v->Data();
4756  if (w!=NULL)
4757  {
4758    if (!idTestHomModule(v_id,currRing->qideal,w))
4759    {
4760      WarnS("wrong weights");
4761      w=NULL;
4762      // and continue at the non-homog case below
4763    }
4764    else
4765    {
4766      w=ivCopy(w);
4767      intvec **ww=&w;
4768      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4769      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4770      return FALSE;
4771    }
4772  }
4773  res->data = (char *)idMinEmbedding(v_id);
4774  return FALSE;
4775}
4776static BOOLEAN jjP2N(leftv res, leftv v)
4777{
4778  number n;
4779  poly p;
4780  if (((p=(poly)v->Data())!=NULL)
4781  && (pIsConstant(p)))
4782  {
4783    n=nCopy(pGetCoeff(p));
4784  }
4785  else
4786  {
4787    n=nInit(0);
4788  }
4789  res->data = (char *)n;
4790  return FALSE;
4791}
4792static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4793{
4794  char *s= (char *)v->Data();
4795  // try system keywords
4796  for(unsigned i=0; i<sArithBase.nCmdUsed; i++)
4797  {
4798    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4799    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4800    {
4801      res->data = (char *)1;
4802      return FALSE;
4803    }
4804  }
4805  // try blackbox names
4806  int id;
4807  blackboxIsCmd(s,id);
4808  if (id>0)
4809  {
4810    res->data = (char *)1;
4811  }
4812  return FALSE;
4813}
4814static BOOLEAN jjRANK1(leftv res, leftv v)
4815{
4816  matrix m =(matrix)v->Data();
4817  int rank = luRank(m, 0);
4818  res->data =(char *)(long)rank;
4819  return FALSE;
4820}
4821static BOOLEAN jjREAD(leftv res, leftv v)
4822{
4823  return jjREAD2(res,v,NULL);
4824}
4825static BOOLEAN jjREGULARITY(leftv res, leftv v)
4826{
4827  res->data = (char *)(long)iiRegularity((lists)v->Data());
4828  return FALSE;
4829}
4830static BOOLEAN jjREPART(leftv res, leftv v)
4831{
4832  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4833  return FALSE;
4834}
4835static BOOLEAN jjRINGLIST(leftv res, leftv v)
4836{
4837  ring r=(ring)v->Data();
4838  if (r!=NULL)
4839  {
4840    res->data = (char *)rDecompose((ring)v->Data());
4841    if (res->data!=NULL)
4842    {
4843      long mm=r->bitmask;
4844      if (mm>MAX_INT_VAL) mm=MAX_INT_VAL;
4845      atSet(res,omStrDup("maxExp"),(void*)mm,INT_CMD);
4846      return FALSE;
4847    }
4848  }
4849  return TRUE;
4850}
4851static BOOLEAN jjRINGLIST_C(leftv res, leftv v)
4852{
4853  coeffs r=(coeffs)v->Data();
4854  if (r!=NULL)
4855    return rDecompose_CF(res,r);
4856  return TRUE;
4857}
4858static BOOLEAN jjRING_LIST(leftv res, leftv v)
4859{
4860  ring r=(ring)v->Data();
4861  if (r!=NULL)
4862    res->data = (char *)rDecompose_list_cf((ring)v->Data());
4863  return (r==NULL)||(res->data==NULL);
4864}
4865static BOOLEAN jjROWS(leftv res, leftv v)
4866{
4867  ideal i = (ideal)v->Data();
4868  res->data = (char *)i->rank;
4869  return FALSE;
4870}
4871static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4872{
4873  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4874  return FALSE;
4875}
4876static BOOLEAN jjROWS_IV(leftv res, leftv v)
4877{
4878  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4879  return FALSE;
4880}
4881static BOOLEAN jjRPAR(leftv res, leftv v)
4882{
4883  res->data = (char *)(long)rPar(((ring)v->Data()));
4884  return FALSE;
4885}
4886static BOOLEAN jjS2I(leftv res, leftv v)
4887{
4888  res->data = (char *)(long)atoi((char*)v->Data());
4889  return FALSE;
4890}
4891static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4892{
4893  const bool bIsSCA = rIsSCA(currRing);
4894
4895  if ((currRing->qideal!=NULL) && !bIsSCA)
4896  {
4897    WerrorS("qring not supported by slimgb at the moment");
4898    return TRUE;
4899  }
4900  if (rHasLocalOrMixedOrdering(currRing))
4901  {
4902    WerrorS("ordering must be global for slimgb");
4903    return TRUE;
4904  }
4905  if (rField_is_numeric(currRing))
4906    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
4907  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4908  // tHomog hom=testHomog;
4909  ideal u_id=(ideal)u->Data();
4910  if (w!=NULL)
4911  {
4912    if (!idTestHomModule(u_id,currRing->qideal,w))
4913    {
4914      WarnS("wrong weights");
4915      w=NULL;
4916    }
4917    else
4918    {
4919      w=ivCopy(w);
4920      // hom=isHomog;
4921    }
4922  }
4923
4924  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4925  res->data=(char *)t_rep_gb(currRing,
4926    u_id,u_id->rank);
4927  //res->data=(char *)t_rep_gb(currRing, u_id);
4928
4929  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4930  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4931  return FALSE;
4932}
4933static BOOLEAN jjSBA(leftv res, leftv v)
4934{
4935  ideal result;
4936  ideal v_id=(ideal)v->Data();
4937  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4938  tHomog hom=testHomog;
4939  if (w!=NULL)
4940  {
4941    if (!idTestHomModule(v_id,currRing->qideal,w))
4942    {
4943      WarnS("wrong weights");
4944      w=NULL;
4945    }
4946    else
4947    {
4948      hom=isHomog;
4949      w=ivCopy(w);
4950    }
4951  }
4952  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4953  idSkipZeroes(result);
4954  res->data = (char *)result;
4955  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4956  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4957  return FALSE;
4958}
4959static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4960{
4961  ideal result;
4962  ideal v_id=(ideal)v->Data();
4963  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4964  tHomog hom=testHomog;
4965  if (w!=NULL)
4966  {
4967    if (!idTestHomModule(v_id,currRing->qideal,w))
4968    {
4969      WarnS("wrong weights");
4970      w=NULL;
4971    }
4972    else
4973    {
4974      hom=isHomog;
4975      w=ivCopy(w);
4976    }
4977  }
4978  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4979  idSkipZeroes(result);
4980  res->data = (char *)result;
4981  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4982  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4983  return FALSE;
4984}
4985static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4986{
4987  ideal result;
4988  ideal v_id=(ideal)v->Data();
4989  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4990  tHomog hom=testHomog;
4991  if (w!=NULL)
4992  {
4993    if (!idTestHomModule(v_id,currRing->qideal,w))
4994    {
4995      WarnS("wrong weights");
4996      w=NULL;
4997    }
4998    else
4999    {
5000      hom=isHomog;
5001      w=ivCopy(w);
5002    }
5003  }
5004  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
5005  idSkipZeroes(result);
5006  res->data = (char *)result;
5007  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5008  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5009  return FALSE;
5010}
5011static BOOLEAN jjSTD(leftv res, leftv v)
5012{
5013  if (rField_is_numeric(currRing))
5014    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5015  ideal result;
5016  ideal v_id=(ideal)v->Data();
5017  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5018  tHomog hom=testHomog;
5019  if (w!=NULL)
5020  {
5021    if (!idTestHomModule(v_id,currRing->qideal,w))
5022    {
5023      WarnS("wrong weights");
5024      w=NULL;
5025    }
5026    else
5027    {
5028      hom=isHomog;
5029      w=ivCopy(w);
5030    }
5031  }
5032  result=kStd(v_id,currRing->qideal,hom,&w);
5033  idSkipZeroes(result);
5034  res->data = (char *)result;
5035  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5036  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5037  return FALSE;
5038}
5039static BOOLEAN jjSort_Id(leftv res, leftv v)
5040{
5041  res->data = (char *)idSort((ideal)v->Data());
5042  return FALSE;
5043}
5044static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5045{
5046  singclap_factorize_retry=0;
5047  intvec *v=NULL;
5048  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5049  if (f==NULL) return TRUE;
5050  ivTest(v);
5051  lists l=(lists)omAllocBin(slists_bin);
5052  l->Init(2);
5053  l->m[0].rtyp=IDEAL_CMD;
5054  l->m[0].data=(void *)f;
5055  l->m[1].rtyp=INTVEC_CMD;
5056  l->m[1].data=(void *)v;
5057  res->data=(void *)l;
5058  return FALSE;
5059}
5060#if 0
5061static BOOLEAN jjSYZYGY(leftv res, leftv v)
5062{
5063  intvec *w=NULL;
5064  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5065  if (w!=NULL) delete w;
5066  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5067  return FALSE;
5068}
5069#else
5070// activate, if idSyz handle module weights correctly !
5071static BOOLEAN jjSYZYGY(leftv res, leftv v)
5072{
5073  ideal v_id=(ideal)v->Data();
5074#ifdef HAVE_SHIFTBBA
5075  if (rIsLPRing(currRing))
5076  {
5077    if (currRing->LPncGenCount < IDELEMS(v_id))
5078    {
5079      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS(v_id));
5080      return TRUE;
5081    }
5082  }
5083#endif
5084  intvec *ww=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5085  intvec *w=NULL;
5086  tHomog hom=testHomog;
5087  if (ww!=NULL)
5088  {
5089    if (idTestHomModule(v_id,currRing->qideal,ww))
5090    {
5091      w=ivCopy(ww);
5092      int add_row_shift=w->min_in();
5093      (*w)-=add_row_shift;
5094      hom=isHomog;
5095    }
5096    else
5097    {
5098      //WarnS("wrong weights");
5099      delete ww; ww=NULL;
5100      hom=testHomog;
5101    }
5102  }
5103  else
5104  {
5105    if (v->Typ()==IDEAL_CMD)
5106      if (idHomIdeal(v_id,currRing->qideal))
5107        hom=isHomog;
5108  }
5109  ideal S=idSyzygies(v_id,hom,&w);
5110  res->data = (char *)S;
5111  if (hom==isHomog)
5112  {
5113    int vl=S->rank;
5114    intvec *vv=new intvec(vl);
5115    if ((v->Typ()==IDEAL_CMD)||(ww==NULL))
5116    {
5117      for(int i=0;i<vl;i++)
5118      {
5119        if (v_id->m[i]!=NULL)
5120          (*vv)[i]=p_Deg(v_id->m[i],currRing);
5121      }
5122    }
5123    else
5124    {
5125      p_SetModDeg(ww, currRing);
5126      for(int i=0;i<vl;i++)
5127      {
5128        if (v_id->m[i]!=NULL)
5129          (*vv)[i]=currRing->pFDeg(v_id->m[i],currRing);
5130      }
5131      p_SetModDeg(NULL, currRing);
5132    }
5133    if (idTestHomModule(S,currRing->qideal,vv))
5134      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
5135    else
5136      delete vv;
5137  }
5138  if (w!=NULL) delete w;
5139  return FALSE;
5140}
5141#endif
5142static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5143{
5144  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5145  return FALSE;
5146}
5147static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5148{
5149  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5150  return FALSE;
5151}
5152static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5153{
5154  res->data = (char *)ivTranp((intvec*)(v->Data()));
5155  return FALSE;
5156}
5157#ifdef HAVE_PLURAL
5158static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5159{
5160  ring    r = (ring)a->Data();
5161  //if (rIsPluralRing(r))
5162  if (r->OrdSgn==1)
5163  {
5164    res->data = rOpposite(r);
5165  }
5166  else
5167  {
5168    WarnS("opposite only for global orderings");
5169    res->data = rCopy(r);
5170  }
5171  return FALSE;
5172}
5173static BOOLEAN jjENVELOPE(leftv res, leftv a)
5174{
5175  ring    r = (ring)a->Data();
5176  if (rIsPluralRing(r))
5177  {
5178    ring s = rEnvelope(r);
5179    res->data = s;
5180  }
5181  else  res->data = rCopy(r);
5182  return FALSE;
5183}
5184static BOOLEAN jjTWOSTD(leftv res, leftv a)
5185{
5186  ideal result;
5187  ideal v_id=(ideal)a->Data();
5188  if (rIsPluralRing(currRing))
5189    result=(ideal)twostd(v_id);
5190  else /*commutative or shiftalgebra*/
5191  {
5192    return jjSTD(res,a);
5193  }
5194  res->data = (char *)result;
5195  setFlag(res,FLAG_STD);
5196  setFlag(res,FLAG_TWOSTD);
5197  return FALSE;
5198}
5199#endif
5200#if defined(HAVE_SHIFTBBA) || defined(HAVE_PLURAL)// do not place above jjSTD in this file because we need to reference it
5201static BOOLEAN jjRIGHTSTD(leftv res, leftv v)
5202{
5203  if (rIsLPRing(currRing))
5204  {
5205    if (rField_is_numeric(currRing))
5206      WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5207    ideal result;
5208    ideal v_id=(ideal)v->Data();
5209    /* intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD); */
5210    /* tHomog hom=testHomog; */
5211    /* if (w!=NULL) */
5212    /* { */
5213    /*   if (!idTestHomModule(v_id,currRing->qideal,w)) */
5214    /*   { */
5215    /*     WarnS("wrong weights"); */
5216    /*     w=NULL; */
5217    /*   } */
5218    /*   else */
5219    /*   { */
5220    /*     hom=isHomog; */
5221    /*     w=ivCopy(w); */
5222    /*   } */
5223    /* } */
5224    /* result=kStd(v_id,currRing->qideal,hom,&w); */
5225    result = rightgb(v_id, currRing->qideal);
5226    idSkipZeroes(result);
5227    res->data = (char *)result;
5228    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5229    /* if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD); */
5230    return FALSE;
5231  }
5232  else if (rIsPluralRing(currRing))
5233  {
5234    ideal I=(ideal)v->Data();
5235
5236    ring A = currRing;
5237    ring Aopp = rOpposite(A);
5238    currRing = Aopp;
5239    ideal Iopp = idOppose(A, I, Aopp);
5240    ideal Jopp = kStd(Iopp,currRing->qideal,testHomog,NULL);
5241    currRing = A;
5242    ideal J = idOppose(Aopp, Jopp, A);
5243
5244    id_Delete(&Iopp, Aopp);
5245    id_Delete(&Jopp, Aopp);
5246    rDelete(Aopp);
5247
5248    idSkipZeroes(J);
5249    res->data = (char *)J;
5250    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5251    return FALSE;
5252  }
5253  else
5254  {
5255    return jjSTD(res, v);
5256  }
5257}
5258#endif
5259static BOOLEAN jjTYPEOF(leftv res, leftv v)
5260{
5261  int t=(int)(long)v->data;
5262  switch (t)
5263  {
5264    case CRING_CMD:
5265    case INT_CMD:
5266    case POLY_CMD:
5267    case VECTOR_CMD:
5268    case STRING_CMD:
5269    case INTVEC_CMD:
5270    case IDEAL_CMD:
5271    case MATRIX_CMD:
5272    case MODUL_CMD:
5273    case MAP_CMD:
5274    case PROC_CMD:
5275    case RING_CMD:
5276    case SMATRIX_CMD:
5277    //case QRING_CMD:
5278    case INTMAT_CMD:
5279    case BIGINTMAT_CMD:
5280    case NUMBER_CMD:
5281    #ifdef SINGULAR_4_2
5282    case CNUMBER_CMD:
5283    #endif
5284    case BIGINT_CMD:
5285    case BUCKET_CMD:
5286    case LIST_CMD:
5287    case PACKAGE_CMD:
5288    case LINK_CMD:
5289    case RESOLUTION_CMD:
5290         res->data=omStrDup(Tok2Cmdname(t)); break;
5291    case DEF_CMD:
5292    case NONE:           res->data=omStrDup("none"); break;
5293    default:
5294    {
5295      if (t>MAX_TOK)
5296        res->data=omStrDup(getBlackboxName(t));
5297      else
5298        res->data=omStrDup("?unknown type?");
5299      break;
5300    }
5301  }
5302  return FALSE;
5303}
5304static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5305{
5306  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5307  return FALSE;
5308}
5309static BOOLEAN jjVAR1(leftv res, leftv v)
5310{
5311  int i=(int)(long)v->Data();
5312  if ((0<i) && (i<=currRing->N))
5313  {
5314    poly p=pOne();
5315    pSetExp(p,i,1);
5316    pSetm(p);
5317    res->data=(char *)p;
5318  }
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 jjVARSTR1(leftv res, leftv v)
5327{
5328  if (currRing==NULL)
5329  {
5330    WerrorS("no ring active (2)");
5331    return TRUE;
5332  }
5333  int i=(int)(long)v->Data();
5334  if ((0<i) && (i<=currRing->N))
5335    res->data=omStrDup(currRing->names[i-1]);
5336  else
5337  {
5338    Werror("var number %d out of range 1..%d",i,currRing->N);
5339    return TRUE;
5340  }
5341  return FALSE;
5342}
5343static BOOLEAN jjVDIM(leftv res, leftv v)
5344{
5345  assumeStdFlag(v);
5346  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5347  return FALSE;
5348}
5349BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5350{
5351// input: u: a list with links of type
5352//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5353// returns: -1:  the read state of all links is eof
5354//          i>0: (at least) u[i] is ready
5355  lists Lforks = (lists)u->Data();
5356  int i = slStatusSsiL(Lforks, -1);
5357  if(i == -2) /* error */
5358  {
5359    return TRUE;
5360  }
5361  res->data = (void*)(long)i;
5362  return FALSE;
5363}
5364BOOLEAN jjWAITALL1(leftv res, leftv u)
5365{
5366// input: u: a list with links of type
5367//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5368// returns: -1: the read state of all links is eof
5369//           1: all links are ready
5370//              (caution: at least one is ready, but some maybe dead)
5371  lists Lforks = (lists)u->CopyD();
5372  int i;
5373  int j = -1;
5374  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5375  {
5376    i = slStatusSsiL(Lforks, -1);
5377    if(i == -2) /* error */
5378    {
5379      return TRUE;
5380    }
5381    if(i == -1)
5382    {
5383      break;
5384    }
5385    j = 1;
5386    Lforks->m[i-1].CleanUp();
5387    Lforks->m[i-1].rtyp=DEF_CMD;
5388    Lforks->m[i-1].data=NULL;
5389  }
5390  res->data = (void*)(long)j;
5391  Lforks->Clean();
5392  return FALSE;
5393}
5394
5395BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5396{
5397  char libnamebuf[1024];
5398  lib_types LT = type_of_LIB(s, libnamebuf);
5399
5400#ifdef HAVE_DYNAMIC_LOADING
5401  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5402#endif /* HAVE_DYNAMIC_LOADING */
5403  switch(LT)
5404  {
5405      default:
5406      case LT_NONE:
5407        Werror("%s: unknown type", s);
5408        break;
5409      case LT_NOTFOUND:
5410        Werror("cannot open %s", s);
5411        break;
5412
5413      case LT_SINGULAR:
5414      {
5415        char *plib = iiConvName(s);
5416        idhdl pl = IDROOT->get_level(plib,0);
5417        if (pl==NULL)
5418        {
5419          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5420          IDPACKAGE(pl)->language = LANG_SINGULAR;
5421          IDPACKAGE(pl)->libname=omStrDup(s);
5422        }
5423        else if (IDTYP(pl)!=PACKAGE_CMD)
5424        {
5425          Werror("can not create package `%s`",plib);
5426          omFree(plib);
5427          return TRUE;
5428        }
5429        else /* package */
5430        {
5431          package pa=IDPACKAGE(pl);
5432          if ((pa->language==LANG_C)
5433          || (pa->language==LANG_MIX))
5434          {
5435            Werror("can not create package `%s` - binaries  exists",plib);
5436            omfree(plib);
5437            return TRUE;
5438          }
5439        }
5440        omFree(plib);
5441        package savepack=currPack;
5442        currPack=IDPACKAGE(pl);
5443        IDPACKAGE(pl)->loaded=TRUE;
5444        char libnamebuf[1024];
5445        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5446        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5447        currPack=savepack;
5448        IDPACKAGE(pl)->loaded=(!bo);
5449        return bo;
5450      }
5451      case LT_BUILTIN:
5452        SModulFunc_t iiGetBuiltinModInit(const char*);
5453        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5454      case LT_MACH_O:
5455      case LT_ELF:
5456      case LT_HPUX:
5457#ifdef HAVE_DYNAMIC_LOADING
5458        return load_modules(s, libnamebuf, autoexport);
5459#else /* HAVE_DYNAMIC_LOADING */
5460        WerrorS("Dynamic modules are not supported by this version of Singular");
5461        break;
5462#endif /* HAVE_DYNAMIC_LOADING */
5463  }
5464  return TRUE;
5465}
5466STATIC_VAR int WerrorS_dummy_cnt=0;
5467static void WerrorS_dummy(const char *)
5468{
5469  WerrorS_dummy_cnt++;
5470}
5471BOOLEAN jjLOAD_TRY(const char *s)
5472{
5473  if (!iiGetLibStatus(s))
5474  {
5475    void (*WerrorS_save)(const char *s) = WerrorS_callback;
5476    WerrorS_callback=WerrorS_dummy;
5477    WerrorS_dummy_cnt=0;
5478    BOOLEAN bo=jjLOAD(s,TRUE);
5479    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5480      Print("loading of >%s< failed\n",s);
5481    WerrorS_callback=WerrorS_save;
5482    errorreported=0;
5483  }
5484  return FALSE;
5485}
5486
5487static BOOLEAN jjstrlen(leftv res, leftv v)
5488{
5489  res->data = (char *)strlen((char *)v->Data());
5490  return FALSE;
5491}
5492static BOOLEAN jjpLength(leftv res, leftv v)
5493{
5494  res->data = (char *)(long)pLength((poly)v->Data());
5495  return FALSE;
5496}
5497static BOOLEAN jjidElem(leftv res, leftv v)
5498{
5499  res->data = (char *)(long)idElem((ideal)v->Data());
5500  return FALSE;
5501}
5502static BOOLEAN jjidFreeModule(leftv res, leftv v)
5503{
5504  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5505  return FALSE;
5506}
5507static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5508{
5509  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5510  return FALSE;
5511}
5512static BOOLEAN jjrCharStr(leftv res, leftv v)
5513{
5514  res->data = rCharStr((ring)v->Data());
5515  return FALSE;
5516}
5517static BOOLEAN jjpHead(leftv res, leftv v)
5518{
5519  res->data = (char *)pHead((poly)v->Data());
5520  return FALSE;
5521}
5522static BOOLEAN jjidHead(leftv res, leftv v)
5523{
5524  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5525  setFlag(res,FLAG_STD);
5526  return FALSE;
5527}
5528static BOOLEAN jjidMinBase(leftv res, leftv v)
5529{
5530  res->data = (char *)idMinBase((ideal)v->Data());
5531  return FALSE;
5532}
5533#if 0 // unused
5534static BOOLEAN jjsyMinBase(leftv res, leftv v)
5535{
5536  res->data = (char *)syMinBase((ideal)v->Data());
5537  return FALSE;
5538}
5539#endif
5540static BOOLEAN jjpMaxComp(leftv res, leftv v)
5541{
5542  res->data = (char *)pMaxComp((poly)v->Data());
5543  return FALSE;
5544}
5545static BOOLEAN jjmpTrace(leftv res, leftv v)
5546{
5547  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5548  return FALSE;
5549}
5550static BOOLEAN jjmpTransp(leftv res, leftv v)
5551{
5552  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5553  return FALSE;
5554}
5555static BOOLEAN jjrOrdStr(leftv res, leftv v)
5556{
5557  res->data = rOrdStr((ring)v->Data());
5558  return FALSE;
5559}
5560static BOOLEAN jjrVarStr(leftv res, leftv v)
5561{
5562  res->data = rVarStr((ring)v->Data());
5563  return FALSE;
5564}
5565static BOOLEAN jjrParStr(leftv res, leftv v)
5566{
5567  res->data = rParStr((ring)v->Data());
5568  return FALSE;
5569}
5570static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5571{
5572  res->data=(char *)(long)sySize((syStrategy)v->Data());
5573  return FALSE;
5574}
5575static BOOLEAN jjDIM_R(leftv res, leftv v)
5576{
5577  res->data = (char *)(long)syDim((syStrategy)v->Data());
5578  return FALSE;
5579}
5580static BOOLEAN jjidTransp(leftv res, leftv v)
5581{
5582  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5583  return FALSE;
5584}
5585static BOOLEAN jjnInt(leftv res, leftv u)
5586{
5587  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5588  res->data=(char *)(long)iin_Int(n,currRing->cf);
5589  n_Delete(&n,currRing->cf);
5590  return FALSE;
5591}
5592static BOOLEAN jjnlInt(leftv res, leftv u)
5593{
5594  number n=(number)u->Data();
5595  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5596  return FALSE;
5597}
5598/*=================== operations with 3 args.: static proc =================*/
5599/* must be ordered: first operations for chars (infix ops),
5600 * then alphabetically */
5601static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5602{
5603  char *s= (char *)u->Data();
5604  int   r = (int)(long)v->Data();
5605  int   c = (int)(long)w->Data();
5606  int l = strlen(s);
5607
5608  if ( (r<1) || (r>l) || (c<0) )
5609  {
5610    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5611    return TRUE;
5612  }
5613  res->data = (char *)omAlloc((long)(c+1));
5614  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5615  return FALSE;
5616}
5617static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5618{
5619  intvec *iv = (intvec *)u->Data();
5620  int   r = (int)(long)v->Data();
5621  int   c = (int)(long)w->Data();
5622  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5623  {
5624    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5625           r,c,u->Fullname(),iv->rows(),iv->cols());
5626    return TRUE;
5627  }
5628  res->data=u->data; u->data=NULL;
5629  res->rtyp=u->rtyp; u->rtyp=0;
5630  res->name=u->name; u->name=NULL;
5631  Subexpr e=jjMakeSub(v);
5632          e->next=jjMakeSub(w);
5633  if (u->e==NULL) res->e=e;
5634  else
5635  {
5636    Subexpr h=u->e;
5637    while (h->next!=NULL) h=h->next;
5638    h->next=e;
5639    res->e=u->e;
5640    u->e=NULL;
5641  }
5642  return FALSE;
5643}
5644static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5645{
5646  bigintmat *bim = (bigintmat *)u->Data();
5647  int   r = (int)(long)v->Data();
5648  int   c = (int)(long)w->Data();
5649  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5650  {
5651    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5652           r,c,u->Fullname(),bim->rows(),bim->cols());
5653    return TRUE;
5654  }
5655  res->data=u->data; u->data=NULL;
5656  res->rtyp=u->rtyp; u->rtyp=0;
5657  res->name=u->name; u->name=NULL;
5658  Subexpr e=jjMakeSub(v);
5659          e->next=jjMakeSub(w);
5660  if (u->e==NULL)
5661    res->e=e;
5662  else
5663  {
5664    Subexpr h=u->e;
5665    while (h->next!=NULL) h=h->next;
5666    h->next=e;
5667    res->e=u->e;
5668    u->e=NULL;
5669  }
5670  return FALSE;
5671}
5672static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5673{
5674  matrix m= (matrix)u->Data();
5675  int   r = (int)(long)v->Data();
5676  int   c = (int)(long)w->Data();
5677  //Print("gen. elem %d, %d\n",r,c);
5678  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5679  {
5680    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5681      MATROWS(m),MATCOLS(m));
5682    return TRUE;
5683  }
5684  res->data=u->data; u->data=NULL;
5685  res->rtyp=u->rtyp; u->rtyp=0;
5686  res->name=u->name; u->name=NULL;
5687  Subexpr e=jjMakeSub(v);
5688          e->next=jjMakeSub(w);
5689  if (u->e==NULL)
5690    res->e=e;
5691  else
5692  {
5693    Subexpr h=u->e;
5694    while (h->next!=NULL) h=h->next;
5695    h->next=e;
5696    res->e=u->e;
5697    u->e=NULL;
5698  }
5699  return FALSE;
5700}
5701static BOOLEAN jjBRACK_SM(leftv res, leftv u, leftv v,leftv w)
5702{
5703  ideal m= (ideal)u->Data();
5704  int   r = (int)(long)v->Data();
5705  int   c = (int)(long)w->Data();
5706  //Print("gen. elem %d, %d\n",r,c);
5707  if ((r<1)||(r>m->rank)||(c<1)||(c>IDELEMS(m)))
5708  {
5709    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5710      (int)m->rank,IDELEMS(m));
5711    return TRUE;
5712  }
5713  res->data=u->data; u->data=NULL;
5714  res->rtyp=u->rtyp; u->rtyp=0;
5715  res->name=u->name; u->name=NULL;
5716  Subexpr e=jjMakeSub(v);
5717          e->next=jjMakeSub(w);
5718  if (u->e==NULL)
5719    res->e=e;
5720  else
5721  {
5722    Subexpr h=u->e;
5723    while (h->next!=NULL) h=h->next;
5724    h->next=e;
5725    res->e=u->e;
5726    u->e=NULL;
5727  }
5728  return FALSE;
5729}
5730static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5731{
5732  sleftv t;
5733  sleftv ut;
5734  leftv p=NULL;
5735  intvec *iv=(intvec *)w->Data();
5736  int l;
5737  BOOLEAN nok;
5738
5739  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5740  {
5741    WerrorS("cannot build expression lists from unnamed objects");
5742    return TRUE;
5743  }
5744  memcpy(&ut,u,sizeof(ut));
5745  memset(&t,0,sizeof(t));
5746  t.rtyp=INT_CMD;
5747  for (l=0;l< iv->length(); l++)
5748  {
5749    t.data=(char *)(long)((*iv)[l]);
5750    if (p==NULL)
5751    {
5752      p=res;
5753    }
5754    else
5755    {
5756      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5757      p=p->next;
5758    }
5759    memcpy(u,&ut,sizeof(ut));
5760    if (u->Typ() == MATRIX_CMD)
5761      nok=jjBRACK_Ma(p,u,v,&t);
5762    else if (u->Typ() == BIGINTMAT_CMD)
5763      nok=jjBRACK_Bim(p,u,v,&t);
5764    else /* INTMAT_CMD */
5765      nok=jjBRACK_Im(p,u,v,&t);
5766    if (nok)
5767    {
5768      while (res->next!=NULL)
5769      {
5770        p=res->next->next;
5771        omFreeBin((ADDRESS)res->next, sleftv_bin);
5772        // res->e aufraeumen !!!!
5773        res->next=p;
5774      }
5775      return TRUE;
5776    }
5777  }
5778  return FALSE;
5779}
5780static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5781{
5782  sleftv t;
5783  sleftv ut;
5784  leftv p=NULL;
5785  intvec *iv=(intvec *)v->Data();
5786  int l;
5787  BOOLEAN nok;
5788
5789  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5790  {
5791    WerrorS("cannot build expression lists from unnamed objects");
5792    return TRUE;
5793  }
5794  memcpy(&ut,u,sizeof(ut));
5795  memset(&t,0,sizeof(t));
5796  t.rtyp=INT_CMD;
5797  for (l=0;l< iv->length(); l++)
5798  {
5799    t.data=(char *)(long)((*iv)[l]);
5800    if (p==NULL)
5801    {
5802      p=res;
5803    }
5804    else
5805    {
5806      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5807      p=p->next;
5808    }
5809    memcpy(u,&ut,sizeof(ut));
5810    if (u->Typ() == MATRIX_CMD)
5811      nok=jjBRACK_Ma(p,u,&t,w);
5812    else if (u->Typ() == BIGINTMAT_CMD)
5813      nok=jjBRACK_Bim(p,u,&t,w);
5814    else /* INTMAT_CMD */
5815      nok=jjBRACK_Im(p,u,&t,w);
5816    if (nok)
5817    {
5818      while (res->next!=NULL)
5819      {
5820        p=res->next->next;
5821        omFreeBin((ADDRESS)res->next, sleftv_bin);
5822        // res->e aufraeumen !!
5823        res->next=p;
5824      }
5825      return TRUE;
5826    }
5827  }
5828  return FALSE;
5829}
5830static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5831{
5832  sleftv t1,t2,ut;
5833  leftv p=NULL;
5834  intvec *vv=(intvec *)v->Data();
5835  intvec *wv=(intvec *)w->Data();
5836  int vl;
5837  int wl;
5838  BOOLEAN nok;
5839
5840  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5841  {
5842    WerrorS("cannot build expression lists from unnamed objects");
5843    return TRUE;
5844  }
5845  memcpy(&ut,u,sizeof(ut));
5846  memset(&t1,0,sizeof(sleftv));
5847  memset(&t2,0,sizeof(sleftv));
5848  t1.rtyp=INT_CMD;
5849  t2.rtyp=INT_CMD;
5850  for (vl=0;vl< vv->length(); vl++)
5851  {
5852    t1.data=(char *)(long)((*vv)[vl]);
5853    for (wl=0;wl< wv->length(); wl++)
5854    {
5855      t2.data=(char *)(long)((*wv)[wl]);
5856      if (p==NULL)
5857      {
5858        p=res;
5859      }
5860      else
5861      {
5862        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5863        p=p->next;
5864      }
5865      memcpy(u,&ut,sizeof(ut));
5866      if (u->Typ() == MATRIX_CMD)
5867        nok=jjBRACK_Ma(p,u,&t1,&t2);
5868      else if (u->Typ() == BIGINTMAT_CMD)
5869        nok=jjBRACK_Bim(p,u,&t1,&t2);
5870      else /* INTMAT_CMD */
5871        nok=jjBRACK_Im(p,u,&t1,&t2);
5872      if (nok)
5873      {
5874        res->CleanUp();
5875        return TRUE;
5876      }
5877    }
5878  }
5879  return FALSE;
5880}
5881static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5882{
5883  v->next=(leftv)omAllocBin(sleftv_bin);
5884  memcpy(v->next,w,sizeof(sleftv));
5885  memset(w,0,sizeof(sleftv));
5886  return jjPROC(res,u,v);
5887}
5888static BOOLEAN jjRING_2(leftv res, leftv u, leftv v, leftv w)
5889{
5890  u->next=(leftv)omAlloc(sizeof(sleftv));
5891  memcpy(u->next,v,sizeof(sleftv));
5892  memset(v,0,sizeof(sleftv));
5893  u->next->next=(leftv)omAlloc(sizeof(sleftv));
5894  memcpy(u->next->next,w,sizeof(sleftv));
5895  memset(w,0,sizeof(sleftv));
5896  BOOLEAN bo=iiExprArithM(res,u,'[');
5897  u->next=NULL;
5898  return bo;
5899}
5900static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5901{
5902  intvec *iv;
5903  ideal m;
5904  lists l=(lists)omAllocBin(slists_bin);
5905  int k=(int)(long)w->Data();
5906  if (k>=0)
5907  {
5908    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5909    l->Init(2);
5910    l->m[0].rtyp=MODUL_CMD;
5911    l->m[1].rtyp=INTVEC_CMD;
5912    l->m[0].data=(void *)m;
5913    l->m[1].data=(void *)iv;
5914  }
5915  else
5916  {
5917    m=sm_CallSolv((ideal)u->Data(), currRing);
5918    l->Init(1);
5919    l->m[0].rtyp=IDEAL_CMD;
5920    l->m[0].data=(void *)m;
5921  }
5922  res->data = (char *)l;
5923  return FALSE;
5924}
5925static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5926{
5927  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5928  {
5929    WerrorS("3rd argument must be a name of a matrix");
5930    return TRUE;
5931  }
5932  ideal i=(ideal)u->Data();
5933  int rank=(int)i->rank;
5934  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5935  if (r) return TRUE;
5936  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5937  return FALSE;
5938}
5939static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5940{
5941  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5942           (ideal)(v->Data()),(poly)(w->Data()));
5943  return FALSE;
5944}
5945static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5946{
5947  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5948  {
5949    WerrorS("3rd argument must be a name of a matrix");
5950    return TRUE;
5951  }
5952  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5953  poly p=(poly)u->CopyD(POLY_CMD);
5954  ideal i=idInit(1,1);
5955  i->m[0]=p;
5956  sleftv t;
5957  memset(&t,0,sizeof(t));
5958  t.data=(char *)i;
5959  t.rtyp=IDEAL_CMD;
5960  int rank=1;
5961  if (u->Typ()==VECTOR_CMD)
5962  {
5963    i->rank=rank=pMaxComp(p);
5964    t.rtyp=MODUL_CMD;
5965  }
5966  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5967  t.CleanUp();
5968  if (r) return TRUE;
5969  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5970  return FALSE;
5971}
5972static BOOLEAN jjELIMIN_ALG(leftv res, leftv u, leftv v, leftv w)
5973{
5974  ideal I=(ideal)u->Data();
5975  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
5976  res->data=(char *)idElimination(I,(poly)v->Data(),NULL,alg);
5977  //setFlag(res,FLAG_STD);
5978  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
5979}
5980static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5981{
5982  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5983    (intvec *)w->Data());
5984  //setFlag(res,FLAG_STD);
5985  return FALSE;
5986}
5987static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5988{
5989  /*4
5990  * look for the substring what in the string where
5991  * starting at position n
5992  * return the position of the first char of what in where
5993  * or 0
5994  */
5995  int n=(int)(long)w->Data();
5996  char *where=(char *)u->Data();
5997  char *what=(char *)v->Data();
5998  char *found;
5999  if ((1>n)||(n>(int)strlen(where)))
6000  {
6001    Werror("start position %d out of range",n);
6002    return TRUE;
6003  }
6004  found = strchr(where+n-1,*what);
6005  if (*(what+1)!='\0')
6006  {
6007    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
6008    {
6009      found=strchr(found+1,*what);
6010    }
6011  }
6012  if (found != NULL)
6013  {
6014    res->data=(char *)((found-where)+1);
6015  }
6016  return FALSE;
6017}
6018static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
6019{
6020  if ((int)(long)w->Data()==0)
6021    res->data=(char *)walkProc(u,v);
6022  else
6023    res->data=(char *)fractalWalkProc(u,v);
6024  setFlag( res, FLAG_STD );
6025  return FALSE;
6026}
6027static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
6028{
6029  intvec *wdegree=(intvec*)w->Data();
6030  if (wdegree->length()!=currRing->N)
6031  {
6032    Werror("weight vector must have size %d, not %d",
6033           currRing->N,wdegree->length());
6034    return TRUE;
6035  }
6036#ifdef HAVE_RINGS
6037  if (rField_is_Z(currRing))
6038  {
6039    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
6040    PrintS("//       performed for generic fibre, that is, over Q\n");
6041  }
6042#endif
6043  assumeStdFlag(u);
6044  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6045  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
6046  if (errorreported) return TRUE;
6047
6048  switch((int)(long)v->Data())
6049  {
6050    case 1:
6051      res->data=(void *)iv;
6052      return FALSE;
6053    case 2:
6054      res->data=(void *)hSecondSeries(iv);
6055      delete iv;
6056      return FALSE;
6057  }
6058  delete iv;
6059  WerrorS(feNotImplemented);
6060  return TRUE;
6061}
6062static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
6063{
6064  PrintS("TODO\n");
6065  int i=pVar((poly)v->Data());
6066  if (i==0)
6067  {
6068    WerrorS("ringvar expected");
6069    return TRUE;
6070  }
6071  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6072  int d=pWTotaldegree(p);
6073  pLmDelete(p);
6074  if (d==1)
6075    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
6076  else
6077    WerrorS("variable must have weight 1");
6078  return (d!=1);
6079}
6080static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
6081{
6082  PrintS("TODO\n");
6083  int i=pVar((poly)v->Data());
6084  if (i==0)
6085  {
6086    WerrorS("ringvar expected");
6087    return TRUE;
6088  }
6089  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6090  int d=pWTotaldegree(p);
6091  pLmDelete(p);
6092  if (d==1)
6093    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
6094  else
6095    WerrorS("variable must have weight 1");
6096  return (d!=1);
6097}
6098static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
6099{
6100  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
6101  intvec* arg = (intvec*) u->Data();
6102  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
6103
6104  for (i=0; i<n; i++)
6105  {
6106    (*im)[i] = (*arg)[i];
6107  }
6108
6109  res->data = (char *)im;
6110  return FALSE;
6111}
6112static BOOLEAN jjINTERSECT3(leftv res, leftv u, leftv v, leftv w)
6113{
6114  ideal I1=(ideal)u->Data();
6115  ideal I2=(ideal)v->Data();
6116  ideal I3=(ideal)w->Data();
6117  resolvente r=(resolvente)omAlloc0(3*sizeof(ideal));
6118  r[0]=I1;
6119  r[1]=I2;
6120  r[2]=I3;
6121  res->data=(char *)idMultSect(r,3);
6122  omFreeSize((ADDRESS)r,3*sizeof(ideal));
6123  return FALSE;
6124}
6125static BOOLEAN jjINTERSEC3S(leftv res, leftv u, leftv v, leftv w)
6126{
6127  ideal I=(ideal)u->Data();
6128  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6129  res->data=(char *)idSect(I,(ideal)v->Data(),alg);
6130  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6131  return FALSE;
6132}
6133static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
6134{
6135  short *iw=iv2array((intvec *)w->Data(),currRing);
6136  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
6137  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
6138  return FALSE;
6139}
6140static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
6141{
6142  if (!pIsUnit((poly)v->Data()))
6143  {
6144    WerrorS("2nd argument must be a unit");
6145    return TRUE;
6146  }
6147  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
6148  return FALSE;
6149}
6150static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
6151{
6152  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
6153                             (intvec *)w->Data(),currRing);
6154  return FALSE;
6155}
6156static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6157{
6158  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6159  {
6160    WerrorS("2nd argument must be a diagonal matrix of units");
6161    return TRUE;
6162  }
6163  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6164                               (matrix)v->CopyD());
6165  return FALSE;
6166}
6167static BOOLEAN jjMINOR_M(leftv res, leftv v)
6168{
6169  /* Here's the use pattern for the minor command:
6170        minor ( matrix_expression m, int_expression minorSize,
6171                optional ideal_expression IasSB, optional int_expression k,
6172                optional string_expression algorithm,
6173                optional int_expression cachedMinors,
6174                optional int_expression cachedMonomials )
6175     This method here assumes that there are at least two arguments.
6176     - If IasSB is present, it must be a std basis. All minors will be
6177       reduced w.r.t. IasSB.
6178     - If k is absent, all non-zero minors will be computed.
6179       If k is present and k > 0, the first k non-zero minors will be
6180       computed.
6181       If k is present and k < 0, the first |k| minors (some of which
6182       may be zero) will be computed.
6183       If k is present and k = 0, an error is reported.
6184     - If algorithm is absent, all the following arguments must be absent too.
6185       In this case, a heuristic picks the best-suited algorithm (among
6186       Bareiss, Laplace, and Laplace with caching).
6187       If algorithm is present, it must be one of "Bareiss", "bareiss",
6188       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6189       "cache" two more arguments may be given, determining how many entries
6190       the cache may have at most, and how many cached monomials there are at
6191       most. (Cached monomials are counted over all cached polynomials.)
6192       If these two additional arguments are not provided, 200 and 100000
6193       will be used as defaults.
6194  */
6195  matrix m;
6196  leftv u=v->next;
6197  v->next=NULL;
6198  int v_typ=v->Typ();
6199  if (v_typ==MATRIX_CMD)
6200  {
6201     m = (const matrix)v->Data();
6202  }
6203  else
6204  {
6205    if (v_typ==0)
6206    {
6207      Werror("`%s` is undefined",v->Fullname());
6208      return TRUE;
6209    }
6210    // try to convert to MATRIX:
6211    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6212    BOOLEAN bo;
6213    sleftv tmp;
6214    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6215    else bo=TRUE;
6216    if (bo)
6217    {
6218      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6219      return TRUE;
6220    }
6221    m=(matrix)tmp.data;
6222  }
6223  const int mk = (const int)(long)u->Data();
6224  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6225  bool noCacheMinors = true; bool noCacheMonomials = true;
6226  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6227
6228  /* here come the different cases of correct argument sets */
6229  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6230  {
6231    IasSB = (ideal)u->next->Data();
6232    noIdeal = false;
6233    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6234    {
6235      k = (int)(long)u->next->next->Data();
6236      noK = false;
6237      if ((u->next->next->next != NULL) &&
6238          (u->next->next->next->Typ() == STRING_CMD))
6239      {
6240        algorithm = (char*)u->next->next->next->Data();
6241        noAlgorithm = false;
6242        if ((u->next->next->next->next != NULL) &&
6243            (u->next->next->next->next->Typ() == INT_CMD))
6244        {
6245          cacheMinors = (int)(long)u->next->next->next->next->Data();
6246          noCacheMinors = false;
6247          if ((u->next->next->next->next->next != NULL) &&
6248              (u->next->next->next->next->next->Typ() == INT_CMD))
6249          {
6250            cacheMonomials =
6251               (int)(long)u->next->next->next->next->next->Data();
6252            noCacheMonomials = false;
6253          }
6254        }
6255      }
6256    }
6257  }
6258  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6259  {
6260    k = (int)(long)u->next->Data();
6261    noK = false;
6262    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6263    {
6264      algorithm = (char*)u->next->next->Data();
6265      noAlgorithm = false;
6266      if ((u->next->next->next != NULL) &&
6267          (u->next->next->next->Typ() == INT_CMD))
6268      {
6269        cacheMinors = (int)(long)u->next->next->next->Data();
6270        noCacheMinors = false;
6271        if ((u->next->next->next->next != NULL) &&
6272            (u->next->next->next->next->Typ() == INT_CMD))
6273        {
6274          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6275          noCacheMonomials = false;
6276        }
6277      }
6278    }
6279  }
6280  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6281  {
6282    algorithm = (char*)u->next->Data();
6283    noAlgorithm = false;
6284    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6285    {
6286      cacheMinors = (int)(long)u->next->next->Data();
6287      noCacheMinors = false;
6288      if ((u->next->next->next != NULL) &&
6289          (u->next->next->next->Typ() == INT_CMD))
6290      {
6291        cacheMonomials = (int)(long)u->next->next->next->Data();
6292        noCacheMonomials = false;
6293      }
6294    }
6295  }
6296
6297  /* upper case conversion for the algorithm if present */
6298  if (!noAlgorithm)
6299  {
6300    if (strcmp(algorithm, "bareiss") == 0)
6301      algorithm = (char*)"Bareiss";
6302    if (strcmp(algorithm, "laplace") == 0)
6303      algorithm = (char*)"Laplace";
6304    if (strcmp(algorithm, "cache") == 0)
6305      algorithm = (char*)"Cache";
6306  }
6307
6308  v->next=u;
6309  /* here come some tests */
6310  if (!noIdeal)
6311  {
6312    assumeStdFlag(u->next);
6313  }
6314  if ((!noK) && (k == 0))
6315  {
6316    WerrorS("Provided number of minors to be computed is zero.");
6317    return TRUE;
6318  }
6319  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6320      && (strcmp(algorithm, "Laplace") != 0)
6321      && (strcmp(algorithm, "Cache") != 0))
6322  {
6323    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6324    return TRUE;
6325  }
6326  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6327      && (!rField_is_Domain(currRing)))
6328  {
6329    Werror("Bareiss algorithm not defined over coefficient rings %s",
6330           "with zero divisors.");
6331    return TRUE;
6332  }
6333  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6334  {
6335    ideal I=idInit(1,1);
6336    if (mk<1) I->m[0]=p_One(currRing);
6337    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6338    //       m->rows(), m->cols());
6339    res->data=(void*)I;
6340    return FALSE;
6341  }
6342  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6343      && (noCacheMinors || noCacheMonomials))
6344  {
6345    cacheMinors = 200;
6346    cacheMonomials = 100000;
6347  }
6348
6349  /* here come the actual procedure calls */
6350  if (noAlgorithm)
6351    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6352                                       (noIdeal ? 0 : IasSB), false);
6353  else if (strcmp(algorithm, "Cache") == 0)
6354    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6355                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6356                                   cacheMonomials, false);
6357  else
6358    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6359                              (noIdeal ? 0 : IasSB), false);
6360  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6361  return FALSE;
6362}
6363static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6364{
6365  // u: the name of the new type
6366  // v: the parent type
6367  // w: the elements
6368  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6369                                            (const char *)w->Data());
6370  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6371  return (d==NULL);
6372}
6373static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6374{
6375  // handles preimage(r,phi,i) and kernel(r,phi)
6376  idhdl h;
6377  ring rr;
6378  map mapping;
6379  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6380
6381  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6382  {
6383    WerrorS("2nd/3rd arguments must have names");
6384    return TRUE;
6385  }
6386  rr=(ring)u->Data();
6387  const char *ring_name=u->Name();
6388  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6389  {
6390    if (h->typ==MAP_CMD)
6391    {
6392      mapping=IDMAP(h);
6393      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6394      if ((preim_ring==NULL)
6395      || (IDRING(preim_ring)!=currRing))
6396      {
6397        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6398        return TRUE;
6399      }
6400    }
6401    else if (h->typ==IDEAL_CMD)
6402    {
6403      mapping=IDMAP(h);
6404    }
6405    else
6406    {
6407      Werror("`%s` is no map nor ideal",IDID(h));
6408      return TRUE;
6409    }
6410  }
6411  else
6412  {
6413    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6414    return TRUE;
6415  }
6416  ideal image;
6417  if (kernel_cmd) image=idInit(1,1);
6418  else
6419  {
6420    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6421    {
6422      if (h->typ==IDEAL_CMD)
6423      {
6424        image=IDIDEAL(h);
6425      }
6426      else
6427      {
6428        Werror("`%s` is no ideal",IDID(h));
6429        return TRUE;
6430      }
6431    }
6432    else
6433    {
6434      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6435      return TRUE;
6436    }
6437  }
6438  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering(currRing)))
6439  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6440  {
6441    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6442  }
6443  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6444  if (kernel_cmd) idDelete(&image);
6445  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6446}
6447static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6448{
6449  int di, k;
6450  int i=(int)(long)u->Data();
6451  int r=(int)(long)v->Data();
6452  int c=(int)(long)w->Data();
6453  if ((r<=0) || (c<=0)) return TRUE;
6454  intvec *iv = new intvec(r, c, 0);
6455  if (iv->rows()==0)
6456  {
6457    delete iv;
6458    return TRUE;
6459  }
6460  if (i!=0)
6461  {
6462    if (i<0) i = -i;
6463    di = 2 * i + 1;
6464    for (k=0; k<iv->length(); k++)
6465    {
6466      (*iv)[k] = ((siRand() % di) - i);
6467    }
6468  }
6469  res->data = (char *)iv;
6470  return FALSE;
6471}
6472#ifdef SINGULAR_4_2
6473static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6474// <coeff>, par1, par2 -> number2
6475{
6476  coeffs cf=(coeffs)u->Data();
6477  if ((cf==NULL) ||(cf->cfRandom==NULL))
6478  {
6479    Werror("no random function defined for coeff %d",cf->type);
6480    return TRUE;
6481  }
6482  else
6483  {
6484    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6485    number2 nn=(number2)omAlloc(sizeof(*nn));
6486    nn->cf=cf;
6487    nn->n=n;
6488    res->data=nn;
6489    return FALSE;
6490  }
6491  return TRUE;
6492}
6493#endif
6494static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6495  int &ringvar, poly &monomexpr)
6496{
6497  monomexpr=(poly)w->Data();
6498  poly p=(poly)v->Data();
6499#if 0
6500  if (pLength(monomexpr)>1)
6501  {
6502    Werror("`%s` substitutes a ringvar only by a term",
6503      Tok2Cmdname(SUBST_CMD));
6504    return TRUE;
6505  }
6506#endif
6507  if ((ringvar=pVar(p))==0)
6508  {
6509    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6510    {
6511      number n = pGetCoeff(p);
6512      ringvar= -n_IsParam(n, currRing);
6513    }
6514    if(ringvar==0)
6515    {
6516      WerrorS("ringvar/par expected");
6517      return TRUE;
6518    }
6519  }
6520  return FALSE;
6521}
6522static BOOLEAN jjSUBST_Bu(leftv res, leftv u, leftv v,leftv w)
6523{
6524  // generic conversion from polyBucket to poly:
6525  // force this to be the first try everytime
6526  poly p; int l;
6527  sBucket_pt bu=(sBucket_pt)w->CopyD();
6528  sBucketDestroyAdd(bu,&p,&l);
6529  sleftv tmpw;
6530  tmpw.Init();
6531  tmpw.rtyp=POLY_CMD;
6532  tmpw.data=p;
6533  return iiExprArith3(res, iiOp, u, v, &tmpw);
6534}
6535static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6536{
6537  int ringvar;
6538  poly monomexpr;
6539  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6540  if (nok) return TRUE;
6541  poly p=(poly)u->Data();
6542  if (ringvar>0)
6543  {
6544    int mm=p_MaxExpPerVar(p,ringvar,currRing);
6545    if ((monomexpr!=NULL) && (p!=NULL) && (mm!=0) &&
6546    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)mm/2)))
6547    {
6548      Warn("possible OVERFLOW in subst, max exponent is %ld, substituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), mm);
6549      //return TRUE;
6550    }
6551    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6552      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6553    else
6554      res->data= pSubstPoly(p,ringvar,monomexpr);
6555  }
6556  else
6557  {
6558#ifdef HAVE_SHIFTBBA
6559    if (rIsLPRing(currRing))
6560    {
6561      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6562      return TRUE;
6563    }
6564#endif
6565    res->data=pSubstPar(p,-ringvar,monomexpr);
6566  }
6567  return FALSE;
6568}
6569static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6570{
6571  int ringvar;
6572  poly monomexpr;
6573  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6574  if (nok) return TRUE;
6575  ideal id=(ideal)u->Data();
6576  if (ringvar>0)
6577  {
6578    BOOLEAN overflow=FALSE;
6579    if (monomexpr!=NULL)
6580    {
6581      long deg_monexp=pTotaldegree(monomexpr);
6582      for(int i=IDELEMS(id)-1;i>=0;i--)
6583      {
6584        poly p=id->m[i];
6585        int mm=p_MaxExpPerVar(p,ringvar,currRing);
6586        if ((p!=NULL) && (mm!=0) &&
6587        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)mm/2)))
6588        {
6589          overflow=TRUE;
6590          break;
6591        }
6592      }
6593    }
6594    if (overflow)
6595      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6596    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6597    {
6598      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6599      else                       id=id_Copy(id,currRing);
6600      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6601    }
6602    else
6603      res->data = idSubstPoly(id,ringvar,monomexpr);
6604  }
6605  else
6606  {
6607#ifdef HAVE_SHIFTBBA
6608    if (rIsLPRing(currRing))
6609    {
6610      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6611      return TRUE;
6612    }
6613#endif
6614    res->data = idSubstPar(id,-ringvar,monomexpr);
6615  }
6616  return FALSE;
6617}
6618// we do not want to have jjSUBST_Id_X inlined:
6619static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6620                            int input_type);
6621static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6622{
6623  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6624}
6625static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6626{
6627  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6628}
6629static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6630{
6631  sleftv tmp;
6632  memset(&tmp,0,sizeof(tmp));
6633  // do not check the result, conversion from int/number to poly works always
6634  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6635  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6636  tmp.CleanUp();
6637  return b;
6638}
6639static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6640{
6641  int mi=(int)(long)v->Data();
6642  int ni=(int)(long)w->Data();
6643  if ((mi<1)||(ni<1))
6644  {
6645    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6646    return TRUE;
6647  }
6648  matrix m=mpNew(mi,ni);
6649  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6650  int i=si_min(IDELEMS(I),mi*ni);
6651  //for(i=i-1;i>=0;i--)
6652  //{
6653  //  m->m[i]=I->m[i];
6654  //  I->m[i]=NULL;
6655  //}
6656  memcpy(m->m,I->m,i*sizeof(poly));
6657  memset(I->m,0,i*sizeof(poly));
6658  id_Delete(&I,currRing);
6659  res->data = (char *)m;
6660  return FALSE;
6661}
6662static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6663{
6664  int mi=(int)(long)v->Data();
6665  int ni=(int)(long)w->Data();
6666  if ((mi<0)||(ni<1))
6667  {
6668    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6669    return TRUE;
6670  }
6671  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6672           mi,ni,currRing);
6673  return FALSE;
6674}
6675static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6676{
6677  int mi=(int)(long)v->Data();
6678  int ni=(int)(long)w->Data();
6679  if ((mi<1)||(ni<1))
6680  {
6681     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6682    return TRUE;
6683  }
6684  matrix m=mpNew(mi,ni);
6685  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6686  int r=si_min(MATROWS(I),mi);
6687  int c=si_min(MATCOLS(I),ni);
6688  int i,j;
6689  for(i=r;i>0;i--)
6690  {
6691    for(j=c;j>0;j--)
6692    {
6693      MATELEM(m,i,j)=MATELEM(I,i,j);
6694      MATELEM(I,i,j)=NULL;
6695    }
6696  }
6697  id_Delete((ideal *)&I,currRing);
6698  res->data = (char *)m;
6699  return FALSE;
6700}
6701static BOOLEAN jjSMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6702{
6703  int mi=(int)(long)v->Data();
6704  int ni=(int)(long)w->Data();
6705  if ((mi<0)||(ni<1))
6706  {
6707    Werror("converting to smatrix: dimensions must be positive(%dx%d)",mi,ni);
6708    return TRUE;
6709  }
6710  res->data = (char *)id_ResizeModule((ideal)u->CopyD(),
6711           mi,ni,currRing);
6712  return FALSE;
6713}
6714static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6715{
6716  if (w->rtyp!=IDHDL) return TRUE;
6717  int ul= IDELEMS((ideal)u->Data());
6718  int vl= IDELEMS((ideal)v->Data());
6719#ifdef HAVE_SHIFTBBA
6720  if (rIsLPRing(currRing))
6721  {
6722    if (currRing->LPncGenCount < ul)
6723    {
6724      Werror("At least %d ncgen variables are needed for this computation.", ul);
6725      return TRUE;
6726    }
6727  }
6728#endif
6729  ideal m
6730    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6731             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6732  if (m==NULL) return TRUE;
6733  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6734  return FALSE;
6735}
6736static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6737{
6738  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6739  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6740  idhdl hv=(idhdl)v->data;
6741  idhdl hw=(idhdl)w->data;
6742#ifdef HAVE_SHIFTBBA
6743  if (rIsLPRing(currRing))
6744  {
6745    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
6746    {
6747      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
6748      return TRUE;
6749    }
6750  }
6751#endif
6752  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6753  res->data = (char *)idLiftStd((ideal)u->Data(),
6754                                &(hv->data.umatrix),testHomog,
6755                                &(hw->data.uideal));
6756  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6757  return FALSE;
6758}
6759static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6760{
6761  assumeStdFlag(v);
6762  if (!idIsZeroDim((ideal)v->Data()))
6763  {
6764    Werror("`%s` must be 0-dimensional",v->Name());
6765    return TRUE;
6766  }
6767  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6768    (poly)w->CopyD());
6769  return FALSE;
6770}
6771static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6772{
6773  assumeStdFlag(v);
6774  if (!idIsZeroDim((ideal)v->Data()))
6775  {
6776    Werror("`%s` must be 0-dimensional",v->Name());
6777    return TRUE;
6778  }
6779  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6780    (matrix)w->CopyD());
6781  return FALSE;
6782}
6783static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6784{
6785  assumeStdFlag(v);
6786  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6787    0,(int)(long)w->Data());
6788  return FALSE;
6789}
6790static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6791{
6792  assumeStdFlag(v);
6793  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6794    0,(int)(long)w->Data());
6795  return FALSE;
6796}
6797#ifdef OLD_RES
6798static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6799{
6800  int maxl=(int)v->Data();
6801  ideal u_id=(ideal)u->Data();
6802  int l=0;
6803  resolvente r;
6804  intvec **weights=NULL;
6805  int wmaxl=maxl;
6806  maxl--;
6807  unsigned save_opt=si_opt_1;
6808  si_opt_1 |= Sy_bit(OPT_REDTAIL_SYZ);
6809  if ((maxl==-1) && (iiOp!=MRES_CMD))
6810    maxl = currRing->N-1;
6811  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6812  {
6813    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6814    if (iv!=NULL)
6815    {
6816      l=1;
6817      if (!idTestHomModule(u_id,currRing->qideal,iv))
6818      {
6819        WarnS("wrong weights");
6820        iv=NULL;
6821      }
6822      else
6823      {
6824        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6825        weights[0] = ivCopy(iv);
6826      }
6827    }
6828    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6829  }
6830  else
6831    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6832  if (r==NULL) return TRUE;
6833  int t3=u->Typ();
6834  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6835  si_opt_1=save_opt;
6836  return FALSE;
6837}
6838#endif
6839static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6840{
6841  res->data=(void *)rInit(u,v,w);
6842  return (res->data==NULL);
6843}
6844static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6845{
6846  int yes;
6847  jjSTATUS2(res, u, v);
6848  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6849  omFree((ADDRESS) res->data);
6850  res->data = (void *)(long)yes;
6851  return FALSE;
6852}
6853static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6854{
6855  intvec *vw=(intvec *)w->Data(); // weights of vars
6856  if (vw->length()!=currRing->N)
6857  {
6858    Werror("%d weights for %d variables",vw->length(),currRing->N);
6859    return TRUE;
6860  }
6861  ideal result;
6862  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6863  tHomog hom=testHomog;
6864  ideal u_id=(ideal)(u->Data());
6865  if (ww!=NULL)
6866  {
6867    if (!idTestHomModule(u_id,currRing->qideal,ww))
6868    {
6869      WarnS("wrong weights");
6870      ww=NULL;
6871    }
6872    else
6873    {
6874      ww=ivCopy(ww);
6875      hom=isHomog;
6876    }
6877  }
6878  result=kStd(u_id,
6879              currRing->qideal,
6880              hom,
6881              &ww,                  // module weights
6882              (intvec *)v->Data(),  // hilbert series
6883              0,0,                  // syzComp, newIdeal
6884              vw);                  // weights of vars
6885  idSkipZeroes(result);
6886  res->data = (char *)result;
6887  setFlag(res,FLAG_STD);
6888  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6889  return FALSE;
6890}
6891
6892/*=================== operations with many arg.: static proc =================*/
6893/* must be ordered: first operations for chars (infix ops),
6894 * then alphabetically */
6895static BOOLEAN jjBREAK0(leftv, leftv)
6896{
6897#ifdef HAVE_SDB
6898  sdb_show_bp();
6899#endif
6900  return FALSE;
6901}
6902static BOOLEAN jjBREAK1(leftv, leftv v)
6903{
6904#ifdef HAVE_SDB
6905  if(v->Typ()==PROC_CMD)
6906  {
6907    int lineno=0;
6908    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6909    {
6910      lineno=(int)(long)v->next->Data();
6911    }
6912    return sdb_set_breakpoint(v->Name(),lineno);
6913  }
6914  return TRUE;
6915#else
6916 return FALSE;
6917#endif
6918}
6919static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6920{
6921  return iiExprArith1(res,v,iiOp);
6922}
6923static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6924{
6925  leftv v=u->next;
6926  u->next=NULL;
6927  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6928  u->next=v;
6929  return b;
6930}
6931static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6932{
6933  leftv v = u->next;
6934  leftv w = v->next;
6935  u->next = NULL;
6936  v->next = NULL;
6937  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6938  u->next = v;
6939  v->next = w;
6940  return b;
6941}
6942
6943static BOOLEAN jjCOEF_M(leftv, leftv v)
6944{
6945  const short t[]={4,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD};
6946  if (iiCheckTypes(v,t,1))
6947  {
6948    idhdl c=(idhdl)v->next->next->data;
6949    if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6950    idhdl m=(idhdl)v->next->next->next->data;
6951    idDelete((ideal *)&(c->data.uideal));
6952    idDelete((ideal *)&(m->data.uideal));
6953    mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6954      (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6955    return FALSE;
6956  }
6957  return TRUE;
6958}
6959
6960static BOOLEAN jjDIVISION4(leftv res, leftv v)
6961{ // may have 3 or 4 arguments
6962  leftv v1=v;
6963  leftv v2=v1->next;
6964  leftv v3=v2->next;
6965  leftv v4=v3->next;
6966  assumeStdFlag(v2);
6967
6968  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6969  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6970
6971  if((i1==0)||(i2==0)
6972  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6973  {
6974    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6975    return TRUE;
6976  }
6977
6978  sleftv w1,w2;
6979  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6980  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6981  ideal P=(ideal)w1.Data();
6982  ideal Q=(ideal)w2.Data();
6983
6984  int n=(int)(long)v3->Data();
6985  short *w=NULL;
6986  if(v4!=NULL)
6987  {
6988    w = iv2array((intvec *)v4->Data(),currRing);
6989    short * w0 = w + 1;
6990    int i = currRing->N;
6991    while( (i > 0) && ((*w0) > 0) )
6992    {
6993      w0++;
6994      i--;
6995    }
6996    if(i>0)
6997      WarnS("not all weights are positive!");
6998  }
6999
7000  matrix T;
7001  ideal R;
7002  idLiftW(P,Q,n,T,R,w);
7003
7004  w1.CleanUp();
7005  w2.CleanUp();
7006  if(w!=NULL)
7007    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
7008
7009  lists L=(lists) omAllocBin(slists_bin);
7010  L->Init(2);
7011  L->m[1].rtyp=v1->Typ();
7012  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
7013  {
7014    if(v1->Typ()==POLY_CMD)
7015      p_Shift(&R->m[0],-1,currRing);
7016    L->m[1].data=(void *)R->m[0];
7017    R->m[0]=NULL;
7018    idDelete(&R);
7019  }
7020  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
7021    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
7022  else
7023  {
7024    L->m[1].rtyp=MODUL_CMD;
7025    L->m[1].data=(void *)R;
7026  }
7027  L->m[0].rtyp=MATRIX_CMD;
7028  L->m[0].data=(char *)T;
7029
7030  res->data=L;
7031
7032  return FALSE;
7033}
7034
7035//BOOLEAN jjDISPATCH(leftv res, leftv v)
7036//{
7037//  WerrorS("`dispatch`: not implemented");
7038//  return TRUE;
7039//}
7040
7041//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
7042//{
7043//  int l=u->listLength();
7044//  if (l<2) return TRUE;
7045//  BOOLEAN b;
7046//  leftv v=u->next;
7047//  leftv zz=v;
7048//  leftv z=zz;
7049//  u->next=NULL;
7050//  do
7051//  {
7052//    leftv z=z->next;
7053//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
7054//    if (b) break;
7055//  } while (z!=NULL);
7056//  u->next=zz;
7057//  return b;
7058//}
7059static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
7060{
7061  int s=1;
7062  leftv h=v;
7063  if (h!=NULL) s=exprlist_length(h);
7064  ideal id=idInit(s,1);
7065  int rank=1;
7066  int i=0;
7067  poly p;
7068  int dest_type=POLY_CMD;
7069  if (iiOp==MODUL_CMD) dest_type=VECTOR_CMD;
7070  while (h!=NULL)
7071  {
7072    // use standard type conversions to poly/vector
7073    int ri;
7074    int ht=h->Typ();
7075    if (ht==dest_type)
7076    {
7077      p=(poly)h->CopyD();
7078      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7079    }
7080    else if ((ri=iiTestConvert(ht,dest_type,dConvertTypes))!=0)
7081    {
7082      sleftv tmp;
7083      leftv hnext=h->next;
7084      h->next=NULL;
7085      iiConvert(ht,dest_type,ri,h,&tmp,dConvertTypes);
7086      h->next=hnext;
7087      p=(poly)tmp.data;
7088      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7089    }
7090    else
7091    {
7092      idDelete(&id);
7093      return TRUE;
7094    }
7095    id->m[i]=p;
7096    i++;
7097    h=h->next;
7098  }
7099  id->rank=rank;
7100  res->data=(char *)id;
7101  return FALSE;
7102}
7103static BOOLEAN jjFETCH_M(leftv res, leftv u)
7104{
7105  ring r=(ring)u->Data();
7106  leftv v=u->next;
7107  leftv perm_var_l=v->next;
7108  leftv perm_par_l=v->next->next;
7109  if ((perm_var_l->Typ()!=INTVEC_CMD)
7110  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
7111  ||(u->Typ()!=RING_CMD))
7112  {
7113    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
7114    return TRUE;
7115  }
7116  intvec *perm_var_v=(intvec*)perm_var_l->Data();
7117  intvec *perm_par_v=NULL;
7118  if (perm_par_l!=NULL)
7119    perm_par_v=(intvec*)perm_par_l->Data();
7120  idhdl w;
7121  nMapFunc nMap;
7122
7123  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
7124  {
7125    int *perm=NULL;
7126    int *par_perm=NULL;
7127    int par_perm_size=0;
7128    BOOLEAN bo;
7129    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
7130    {
7131      // Allow imap/fetch to be make an exception only for:
7132      if (nCoeff_is_Extension(r->cf) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
7133         ((n_SetMap(r->cf->extRing->cf,currRing->cf)!=NULL)
7134         || (nCoeff_is_Extension(currRing->cf) && (n_SetMap(r->cf->extRing->cf,currRing->cf->extRing->cf)!=NULL))))
7135      {
7136        par_perm_size=rPar(r);
7137      }
7138      else
7139      {
7140        goto err_fetch;
7141      }
7142    }
7143    else
7144      par_perm_size=rPar(r);
7145    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
7146    if (par_perm_size!=0)
7147      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
7148    int i;
7149    if (perm_par_l==NULL)
7150    {
7151      if (par_perm_size!=0)
7152        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
7153    }
7154    else
7155    {
7156      if (par_perm_size==0) WarnS("source ring has no parameters");
7157      else
7158      {
7159        for(i=rPar(r)-1;i>=0;i--)
7160        {
7161          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
7162          if ((par_perm[i]<-rPar(currRing))
7163          || (par_perm[i]>rVar(currRing)))
7164          {
7165            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
7166            par_perm[i]=0;
7167          }
7168        }
7169      }
7170    }
7171    for(i=rVar(r)-1;i>=0;i--)
7172    {
7173      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
7174      if ((perm[i]<-rPar(currRing))
7175      || (perm[i]>rVar(currRing)))
7176      {
7177        Warn("invalid entry for var %d: %d\n",i,perm[i]);
7178        perm[i]=0;
7179      }
7180    }
7181    if (BVERBOSE(V_IMAP))
7182    {
7183      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
7184      {
7185        if (perm[i]>0)
7186          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
7187        else if (perm[i]<0)
7188          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
7189      }
7190      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
7191      {
7192        if (par_perm[i-1]<0)
7193          Print("// par nr %d: %s -> par %s\n",
7194              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
7195        else if (par_perm[i-1]>0)
7196          Print("// par nr %d: %s -> var %s\n",
7197              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7198      }
7199    }
7200    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7201    sleftv tmpW;
7202    memset(&tmpW,0,sizeof(sleftv));
7203    tmpW.rtyp=IDTYP(w);
7204    tmpW.data=IDDATA(w);
7205    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7206                         perm,par_perm,par_perm_size,nMap)))
7207    {
7208      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7209    }
7210    if (perm!=NULL)
7211      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7212    if (par_perm!=NULL)
7213      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7214    return bo;
7215  }
7216  else
7217  {
7218    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7219  }
7220  return TRUE;
7221err_fetch:
7222  char *s1=nCoeffString(r->cf);
7223  char *s2=nCoeffString(currRing->cf);
7224  Werror("no identity map from %s (%s -> %s)",u->Fullname(),s1,s2);
7225  omFree(s2);omFree(s1);
7226  return TRUE;
7227}
7228static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7229{
7230  leftv h=v;
7231  int l=v->listLength();
7232  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7233  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7234  int t=0;
7235  // try to convert to IDEAL_CMD
7236  while (h!=NULL)
7237  {
7238    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7239    {
7240      t=IDEAL_CMD;
7241    }
7242    else break;
7243    h=h->next;
7244  }
7245  // if failure, try MODUL_CMD
7246  if (t==0)
7247  {
7248    h=v;
7249    while (h!=NULL)
7250    {
7251      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7252      {
7253        t=MODUL_CMD;
7254      }
7255      else break;
7256      h=h->next;
7257    }
7258  }
7259  // check for success  in converting
7260  if (t==0)
7261  {
7262    WerrorS("cannot convert to ideal or module");
7263    return TRUE;
7264  }
7265  // call idMultSect
7266  h=v;
7267  int i=0;
7268  sleftv tmp;
7269  while (h!=NULL)
7270  {
7271    if (h->Typ()==t)
7272    {
7273      r[i]=(ideal)h->Data(); /*no copy*/
7274      h=h->next;
7275    }
7276    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7277    {
7278      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7279      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7280      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7281      return TRUE;
7282    }
7283    else
7284    {
7285      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7286      copied[i]=TRUE;
7287      h=tmp.next;
7288    }
7289    i++;
7290  }
7291  res->rtyp=t;
7292  res->data=(char *)idMultSect(r,i);
7293  while(i>0)
7294  {
7295    i--;
7296    if (copied[i]) idDelete(&(r[i]));
7297  }
7298  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7299  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7300  return FALSE;
7301}
7302static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7303{
7304  /* computation of the inverse of a quadratic matrix A
7305     using the L-U-decomposition of A;
7306     There are two valid parametrisations:
7307     1) exactly one argument which is just the matrix A,
7308     2) exactly three arguments P, L, U which already
7309        realise the L-U-decomposition of A, that is,
7310        P * A = L * U, and P, L, and U satisfy the
7311        properties decribed in method 'jjLU_DECOMP';
7312        see there;
7313     If A is invertible, the list [1, A^(-1)] is returned,
7314     otherwise the list [0] is returned. Thus, the user may
7315     inspect the first entry of the returned list to see
7316     whether A is invertible. */
7317  matrix iMat; int invertible;
7318  const short t1[]={1,MATRIX_CMD};
7319  const short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7320  if (iiCheckTypes(v,t1))
7321  {
7322    matrix aMat = (matrix)v->Data();
7323    int rr = aMat->rows();
7324    int cc = aMat->cols();
7325    if (rr != cc)
7326    {
7327      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7328      return TRUE;
7329    }
7330    if (!idIsConstant((ideal)aMat))
7331    {
7332      WerrorS("matrix must be constant");
7333      return TRUE;
7334    }
7335    invertible = luInverse(aMat, iMat);
7336  }
7337  else if (iiCheckTypes(v,t2))
7338  {
7339     matrix pMat = (matrix)v->Data();
7340     matrix lMat = (matrix)v->next->Data();
7341     matrix uMat = (matrix)v->next->next->Data();
7342     int rr = uMat->rows();
7343     int cc = uMat->cols();
7344     if (rr != cc)
7345     {
7346       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7347              rr, cc);
7348       return TRUE;
7349     }
7350      if (!idIsConstant((ideal)pMat)
7351      || (!idIsConstant((ideal)lMat))
7352      || (!idIsConstant((ideal)uMat))
7353      )
7354      {
7355        WerrorS("matricesx must be constant");
7356        return TRUE;
7357      }
7358     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7359  }
7360  else
7361  {
7362    Werror("expected either one or three matrices");
7363    return TRUE;
7364  }
7365
7366  /* build the return structure; a list with either one or two entries */
7367  lists ll = (lists)omAllocBin(slists_bin);
7368  if (invertible)
7369  {
7370    ll->Init(2);
7371    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7372    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7373  }
7374  else
7375  {
7376    ll->Init(1);
7377    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7378  }
7379
7380  res->data=(char*)ll;
7381  return FALSE;
7382}
7383static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7384{
7385  /* for solving a linear equation system A * x = b, via the
7386     given LU-decomposition of the matrix A;
7387     There is one valid parametrisation:
7388     1) exactly four arguments P, L, U, b;
7389        P, L, and U realise the L-U-decomposition of A, that is,
7390        P * A = L * U, and P, L, and U satisfy the
7391        properties decribed in method 'jjLU_DECOMP';
7392        see there;
7393        b is the right-hand side vector of the equation system;
7394     The method will return a list of either 1 entry or three entries:
7395     1) [0] if there is no solution to the system;
7396     2) [1, x, H] if there is at least one solution;
7397        x is any solution of the given linear system,
7398        H is the matrix with column vectors spanning the homogeneous
7399        solution space.
7400     The method produces an error if matrix and vector sizes do not fit. */
7401  const short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7402  if (!iiCheckTypes(v,t))
7403  {
7404    WerrorS("expected exactly three matrices and one vector as input");
7405    return TRUE;
7406  }
7407  matrix pMat = (matrix)v->Data();
7408  matrix lMat = (matrix)v->next->Data();
7409  matrix uMat = (matrix)v->next->next->Data();
7410  matrix bVec = (matrix)v->next->next->next->Data();
7411  matrix xVec; int solvable; matrix homogSolSpace;
7412  if (pMat->rows() != pMat->cols())
7413  {
7414    Werror("first matrix (%d x %d) is not quadratic",
7415           pMat->rows(), pMat->cols());
7416    return TRUE;
7417  }
7418  if (lMat->rows() != lMat->cols())
7419  {
7420    Werror("second matrix (%d x %d) is not quadratic",
7421           lMat->rows(), lMat->cols());
7422    return TRUE;
7423  }
7424  if (lMat->rows() != uMat->rows())
7425  {
7426    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7427           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7428    return TRUE;
7429  }
7430  if (uMat->rows() != bVec->rows())
7431  {
7432    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7433           uMat->rows(), uMat->cols(), bVec->rows());
7434    return TRUE;
7435  }
7436  if (!idIsConstant((ideal)pMat)
7437  ||(!idIsConstant((ideal)lMat))
7438  ||(!idIsConstant((ideal)uMat))
7439  )
7440  {
7441    WerrorS("matrices must be constant");
7442    return TRUE;
7443  }
7444  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7445
7446  /* build the return structure; a list with either one or three entries */
7447  lists ll = (lists)omAllocBin(slists_bin);
7448  if (solvable)
7449  {
7450    ll->Init(3);
7451    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7452    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7453    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7454  }
7455  else
7456  {
7457    ll->Init(1);
7458    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7459  }
7460
7461  res->data=(char*)ll;
7462  return FALSE;
7463}
7464static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7465{
7466  int i=0;
7467  leftv h=v;
7468  if (h!=NULL) i=exprlist_length(h);
7469  intvec *iv=new intvec(i);
7470  i=0;
7471  while (h!=NULL)
7472  {
7473    if(h->Typ()==INT_CMD)
7474    {
7475      (*iv)[i]=(int)(long)h->Data();
7476    }
7477    else if (h->Typ()==INTVEC_CMD)
7478    {
7479      intvec *ivv=(intvec*)h->Data();
7480      for(int j=0;j<ivv->length();j++,i++)
7481      {
7482        (*iv)[i]=(*ivv)[j];
7483      }
7484      i--;
7485    }
7486    else
7487    {
7488      delete iv;
7489      return TRUE;
7490    }
7491    i++;
7492    h=h->next;
7493  }
7494  res->data=(char *)iv;
7495  return FALSE;
7496}
7497static BOOLEAN jjJET4(leftv res, leftv u)
7498{
7499  const short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7500  const short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7501  const short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7502  const short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7503  leftv u1=u;
7504  leftv u2=u1->next;
7505  leftv u3=u2->next;
7506  leftv u4=u3->next;
7507  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7508  {
7509    if(!pIsUnit((poly)u2->Data()))
7510    {
7511      WerrorS("2nd argument must be a unit");
7512      return TRUE;
7513    }
7514    res->rtyp=u1->Typ();
7515    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7516                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7517    return FALSE;
7518  }
7519  else
7520  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7521  {
7522    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7523    {
7524      WerrorS("2nd argument must be a diagonal matrix of units");
7525      return TRUE;
7526    }
7527    res->rtyp=u1->Typ();
7528    res->data=(char*)idSeries(
7529                              (int)(long)u3->Data(),
7530                              idCopy((ideal)u1->Data()),
7531                              mp_Copy((matrix)u2->Data(), currRing),
7532                              (intvec*)u4->Data()
7533                             );
7534    return FALSE;
7535  }
7536  else
7537  {
7538    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7539           Tok2Cmdname(iiOp));
7540    return TRUE;
7541  }
7542}
7543#if 0
7544static BOOLEAN jjBRACKET_PL(leftv res, leftv u)
7545{
7546  int ut=u->Typ();
7547  leftv v=u->next; u->next=NULL;
7548  leftv w=v->next; v->next=NULL;
7549  if ((ut!=CRING_CMD)&&(ut!=RING_CMD))
7550  {
7551    BOOLEAN bo=TRUE;
7552    if (w==NULL)
7553    {
7554      bo=iiExprArith2(res,u,'[',v);
7555    }
7556    else if (w->next==NULL)
7557    {
7558      bo=iiExprArith3(res,'[',u,v,w);
7559    }
7560    v->next=w;
7561    u->next=v;
7562    return bo;
7563  }
7564  v->next=w;
7565  u->next=v;
7566  #ifdef SINGULAR_4_1
7567  // construct new rings:
7568  while (u!=NULL)
7569  {
7570    Print("name: %s,\n",u->Name());
7571    u=u->next;
7572  }
7573  #else
7574  memset(res,0,sizeof(sleftv));
7575  res->rtyp=NONE;
7576  return TRUE;
7577  #endif
7578}
7579#endif
7580static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7581{
7582  if ((yyInRingConstruction)
7583  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7584  {
7585    memcpy(res,u,sizeof(sleftv));
7586    memset(u,0,sizeof(sleftv));
7587    return FALSE;
7588  }
7589  leftv v=u->next;
7590  BOOLEAN b;
7591  if(v==NULL)  // p()
7592    b=iiExprArith1(res,u,iiOp);
7593  else if ((v->next==NULL) // p(1)
7594  || (u->Typ()!=UNKNOWN))  // p(1,2), p proc or map
7595  {
7596    u->next=NULL;
7597    b=iiExprArith2(res,u,iiOp,v);
7598    u->next=v;
7599  }
7600  else // p(1,2), p undefined
7601  {
7602    if (v->Typ()!=INT_CMD)
7603    {
7604      Werror("`int` expected while building `%s(`",u->name);
7605      return TRUE;
7606    }
7607    int l=u->listLength();
7608    char * nn = (char *)omAlloc(strlen(u->name) + 12*l);
7609    sprintf(nn,"%s(%d",u->name,(int)(long)v->Data());
7610    char *s=nn;
7611    do
7612    {
7613      while (*s!='\0') s++;
7614      v=v->next;
7615      if (v->Typ()!=INT_CMD)
7616      {
7617        Werror("`int` expected while building `%s`",nn);
7618        omFree((ADDRESS)nn);
7619        return TRUE;
7620      }
7621      sprintf(s,",%d",(int)(long)v->Data());
7622    } while (v->next!=NULL);
7623    while (*s!='\0') s++;
7624    nn=strcat(nn,")");
7625    char *n=omStrDup(nn);
7626    omFree((ADDRESS)nn);
7627    syMake(res,n);
7628    b=FALSE;
7629  }
7630  return b;
7631}
7632static BOOLEAN jjLIFT_4(leftv res, leftv U)
7633{
7634  const short t1[]={4,IDEAL_CMD,IDEAL_CMD,MATRIX_CMD,STRING_CMD};
7635  const short t2[]={4,MODUL_CMD,MODUL_CMD,MATRIX_CMD,STRING_CMD};
7636  leftv u=U;
7637  leftv v=u->next;
7638  leftv w=v->next;
7639  leftv u4=w->next;
7640  if (w->rtyp!=IDHDL) return TRUE;
7641  if (iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7642  {
7643    // see jjLIFT3
7644    ideal I=(ideal)u->Data();
7645    int ul= IDELEMS(I /*(ideal)u->Data()*/);
7646    int vl= IDELEMS((ideal)v->Data());
7647    GbVariant alg=syGetAlgorithm((char*)u4->Data(),currRing,I);
7648    ideal m
7649    = idLift(I,(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
7650             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))),alg);
7651    if (m==NULL) return TRUE;
7652    res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
7653    return FALSE;
7654  }
7655  else
7656  {
7657    Werror("%s(`ideal`,`ideal`,`matrix`,`string`)\n"
7658           "or (`module`,`module`,`matrix`,`string`) expected",
7659           Tok2Cmdname(iiOp));
7660    return TRUE;
7661  }
7662}
7663static BOOLEAN jjLIFTSTD_4(leftv res, leftv U)
7664{
7665  const short t1[]={4,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7666  const short t2[]={4,MODUL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7667  leftv u=U;
7668  leftv v=u->next;
7669  leftv w=v->next;
7670  leftv u4=w->next;
7671  if (v->rtyp!=IDHDL) return TRUE;
7672  if (w->rtyp!=IDHDL) return TRUE;
7673  if (iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7674  {
7675    // see jjLIFTSTD3
7676    ideal I=(ideal)u->Data();
7677    idhdl hv=(idhdl)v->data;
7678    idhdl hw=(idhdl)w->data;
7679    GbVariant alg=syGetAlgorithm((char*)u4->Data(),currRing,I);
7680    // CopyD for IDEAL_CMD and MODUL_CMD are identical:
7681    res->data = (char *)idLiftStd((ideal)u->Data(),
7682                                &(hv->data.umatrix),testHomog,
7683                                &(hw->data.uideal),alg);
7684    setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
7685    return FALSE;
7686  }
7687  else
7688  {
7689    Werror("%s(`ideal`,`matrix`,`module`,`string`)\n"
7690           "or (`module`,`matrix`,`module`,`string`) expected",
7691           Tok2Cmdname(iiOp));
7692    return TRUE;
7693  }
7694}
7695BOOLEAN jjLIST_PL(leftv res, leftv v)
7696{
7697  int sl=0;
7698  if (v!=NULL) sl = v->listLength();
7699  lists L;
7700  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7701  {
7702    int add_row_shift = 0;
7703    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7704    if (weights!=NULL)  add_row_shift=weights->min_in();
7705    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7706  }
7707  else
7708  {
7709    L=(lists)omAllocBin(slists_bin);
7710    leftv h=NULL;
7711    int i;
7712    int rt;
7713
7714    L->Init(sl);
7715    for (i=0;i<sl;i++)
7716    {
7717      if (h!=NULL)
7718      { /* e.g. not in the first step:
7719         * h is the pointer to the old sleftv,
7720         * v is the pointer to the next sleftv
7721         * (in this moment) */
7722         h->next=v;
7723      }
7724      h=v;
7725      v=v->next;
7726      h->next=NULL;
7727      rt=h->Typ();
7728      if (rt==0)
7729      {
7730        L->Clean();
7731        Werror("`%s` is undefined",h->Fullname());
7732        return TRUE;
7733      }
7734      if (rt==RING_CMD)
7735      {
7736        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7737        ((ring)L->m[i].data)->ref++;
7738      }
7739      else
7740        L->m[i].Copy(h);
7741    }
7742  }
7743  res->data=(char *)L;
7744  return FALSE;
7745}
7746static BOOLEAN jjNAMES0(leftv res, leftv)
7747{
7748  res->data=(void *)ipNameList(IDROOT);
7749  return FALSE;
7750}
7751static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7752{
7753  if(v==NULL)
7754  {
7755    res->data=(char *)showOption();
7756    return FALSE;
7757  }
7758  res->rtyp=NONE;
7759  return setOption(res,v);
7760}
7761static BOOLEAN jjREDUCE4(leftv res, leftv u)
7762{
7763  leftv u1=u;
7764  leftv u2=u1->next;
7765  leftv u3=u2->next;
7766  leftv u4=u3->next;
7767  int u1t=u1->Typ(); if (u1t==BUCKET_CMD) u1t=POLY_CMD;
7768  int u2t=u2->Typ(); if (u2t==BUCKET_CMD) u2t=POLY_CMD;
7769  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7770  {
7771    int save_d=Kstd1_deg;
7772    Kstd1_deg=(int)(long)u3->Data();
7773    kModW=(intvec *)u4->Data();
7774    BITSET save2;
7775    SI_SAVE_OPT2(save2);
7776    si_opt_2|=Sy_bit(V_DEG_STOP);
7777    u2->next=NULL;
7778    BOOLEAN r=jjCALL2ARG(res,u);
7779    kModW=NULL;
7780    Kstd1_deg=save_d;
7781    SI_RESTORE_OPT2(save2);
7782    u->next->next=u3;
7783    return r;
7784  }
7785  else
7786  if((u1t==IDEAL_CMD)&&(u2t==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7787     (u4->Typ()==INT_CMD))
7788  {
7789    assumeStdFlag(u3);
7790    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7791    {
7792      WerrorS("2nd argument must be a diagonal matrix of units");
7793      return TRUE;
7794    }
7795    res->data=(char*)redNF(
7796                           idCopy((ideal)u3->Data()),
7797                           idCopy((ideal)u1->Data()),
7798                           mp_Copy((matrix)u2->Data(), currRing),
7799                           (int)(long)u4->Data()
7800                          );
7801    return FALSE;
7802  }
7803  else
7804  if((u1t==POLY_CMD)&&(u2t==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7805     (u4->Typ()==INT_CMD))
7806  {
7807    poly u1p;
7808    if (u1->Typ()==BUCKET_CMD) u1p=sBucketPeek((sBucket_pt)u1->Data());
7809    else                     u1p=(poly)u1->Data();
7810    poly u2p;
7811    if (u2->Typ()==BUCKET_CMD) u2p=sBucketPeek((sBucket_pt)u2->Data());
7812    else                     u2p=(poly)u2->Data();
7813    assumeStdFlag(u3);
7814    if(!pIsUnit(u2p))
7815    {
7816      WerrorS("2nd argument must be a unit");
7817      return TRUE;
7818    }
7819    res->rtyp=POLY_CMD;
7820    res->data=(char*)redNF((ideal)u3->CopyD(),pCopy(u1p),
7821                           pCopy(u2p),(int)(long)u4->Data());
7822    return FALSE;
7823  }
7824  else
7825  {
7826    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7827    Werror("%s(`ideal`,`matrix`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
7828    Werror("%s(`poly`,`poly`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
7829    return TRUE;
7830  }
7831}
7832static BOOLEAN jjREDUCE5(leftv res, leftv u)
7833{
7834  leftv u1=u;
7835  leftv u2=u1->next;
7836  leftv u3=u2->next;
7837  leftv u4=u3->next;
7838  leftv u5=u4->next;
7839  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7840     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7841  {
7842    assumeStdFlag(u3);
7843    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7844    {
7845      WerrorS("2nd argument must be a diagonal matrix of units");
7846      return TRUE;
7847    }
7848    res->data=(char*)redNF(
7849                           idCopy((ideal)u3->Data()),
7850                           idCopy((ideal)u1->Data()),
7851                           mp_Copy((matrix)u2->Data(),currRing),
7852                           (int)(long)u4->Data(),
7853                           (intvec*)u5->Data()
7854                          );
7855    return FALSE;
7856  }
7857  else
7858  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7859     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7860  {
7861    assumeStdFlag(u3);
7862    if(!pIsUnit((poly)u2->Data()))
7863    {
7864      WerrorS("2nd argument must be a unit");
7865      return TRUE;
7866    }
7867    res->rtyp=POLY_CMD;
7868    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7869                           pCopy((poly)u2->Data()),
7870                           (int)(long)u4->Data(),(intvec*)u5->Data());
7871    return FALSE;
7872  }
7873  else
7874  {
7875    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7876           Tok2Cmdname(iiOp));
7877    return TRUE;
7878  }
7879}
7880static BOOLEAN jjRESERVED0(leftv, leftv)
7881{
7882  unsigned i=1;
7883  unsigned nCount = (sArithBase.nCmdUsed-1)/3;
7884  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7885  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7886  //      sArithBase.nCmdAllocated);
7887  for(i=0; i<nCount; i++)
7888  {
7889    Print("%-20s",sArithBase.sCmds[i+1].name);
7890    if(i+1+nCount<sArithBase.nCmdUsed)
7891      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7892    if(i+1+2*nCount<sArithBase.nCmdUsed)
7893      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7894    //if ((i%3)==1) PrintLn();
7895    PrintLn();
7896  }
7897  PrintLn();
7898  printBlackboxTypes();
7899  return FALSE;
7900}
7901
7902static BOOLEAN jjRESERVEDLIST0(leftv res, leftv)
7903{
7904        unsigned i=1;
7905        int l = 0;
7906        int k = 0;
7907        lists L = (lists)omAllocBin(slists_bin);
7908        struct blackbox_list *bb_list = NULL;
7909        unsigned nCount = (sArithBase.nCmdUsed-1) / 3;
7910
7911        if ((3*nCount) < sArithBase.nCmdUsed) {
7912                nCount++;
7913        }
7914        bb_list = getBlackboxTypes();
7915        // count the  number of entries;
7916        for (i=0; i<nCount; i++) {
7917                l++;
7918                if (i + 1 + nCount < sArithBase.nCmdUsed) {
7919                        l++;
7920                }
7921                if(i+1+2*nCount<sArithBase.nCmdUsed) {
7922                        l++;
7923                }
7924        }
7925        for (i = 0; i < bb_list->count; i++) {
7926                if (bb_list->list[i] != NULL) {
7927                        l++;
7928                }
7929        }
7930        // initiate list
7931        L->Init(l);
7932        k = 0;
7933        for (i=0; i<nCount; i++) {
7934                L->m[k].rtyp = STRING_CMD;
7935                L->m[k].data = omStrDup(sArithBase.sCmds[i+1].name);
7936                k++;
7937                // Print("%-20s", sArithBase.sCmds[i+1].name);
7938                if (i + 1 + nCount < sArithBase.nCmdUsed) {
7939                        L->m[k].rtyp = STRING_CMD;
7940                        L->m[k].data = omStrDup(sArithBase.sCmds[i+1+nCount].name);
7941                        k++;
7942                        // Print("%-20s", sArithBase.sCmds[i+1 + nCount].name);
7943                }
7944                if(i+1+2*nCount<sArithBase.nCmdUsed) {
7945                        L->m[k].rtyp = STRING_CMD;
7946                        L->m[k].data = omStrDup(sArithBase.sCmds[i+1+2*nCount].name);
7947                        k++;
7948                        // Print("%-20s", sArithBase.sCmds[i+1+2*nCount].name);
7949                }
7950                // PrintLn();
7951        }
7952
7953        // assign blackbox types
7954        for (i = 0; i < bb_list->count; i++) {
7955                if (bb_list->list[i] != NULL) {
7956                        L->m[k].rtyp = STRING_CMD;
7957                        // already used strdup in getBlackBoxTypes
7958                        L->m[k].data = bb_list->list[i];
7959                        k++;
7960                }
7961        }
7962        // free the struct (not the list entries itself, which were allocated
7963        // by strdup)
7964        omfree(bb_list->list);
7965        omfree(bb_list);
7966
7967        // pass the resultant list to the res datastructure
7968        res->data=(void *)L;
7969
7970        return FALSE;
7971}
7972static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7973{
7974  if (v == NULL)
7975  {
7976    res->data = omStrDup("");
7977    return FALSE;
7978  }
7979  int n = v->listLength();
7980  if (n == 1)
7981  {
7982    res->data = v->String();
7983    return FALSE;
7984  }
7985
7986  char** slist = (char**) omAlloc(n*sizeof(char*));
7987  int i, j;
7988
7989  for (i=0, j=0; i<n; i++, v = v ->next)
7990  {
7991    slist[i] = v->String();
7992    assume(slist[i] != NULL);
7993    j+=strlen(slist[i]);
7994  }
7995  char* s = (char*) omAlloc((j+1)*sizeof(char));
7996  *s='\0';
7997  for (i=0;i<n;i++)
7998  {
7999    strcat(s, slist[i]);
8000    omFree(slist[i]);
8001  }
8002  omFreeSize(slist, n*sizeof(char*));
8003  res->data = s;
8004  return FALSE;
8005}
8006static BOOLEAN jjTEST(leftv, leftv v)
8007{
8008  do
8009  {
8010    if (v->Typ()!=INT_CMD)
8011      return TRUE;
8012    test_cmd((int)(long)v->Data());
8013    v=v->next;
8014  }
8015  while (v!=NULL);
8016  return FALSE;
8017}
8018
8019#if defined(__alpha) && !defined(linux)
8020extern "C"
8021{
8022  void usleep(unsigned long usec);
8023};
8024#endif
8025static BOOLEAN jjFactModD_M(leftv res, leftv v)
8026{
8027  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
8028     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
8029
8030     valid argument lists:
8031     - (poly h, int d),
8032     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
8033     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
8034                                                          in list of ring vars,
8035     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
8036                                                optional: all 4 optional args
8037     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
8038      by singclap_factorize and h(0, y)
8039      has exactly two distinct monic factors [possibly with exponent > 1].)
8040     result:
8041     - list with the two factors f and g such that
8042       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
8043
8044  poly h      = NULL;
8045  int  d      =    1;
8046  poly f0     = NULL;
8047  poly g0     = NULL;
8048  int  xIndex =    1;   /* default index if none provided */
8049  int  yIndex =    2;   /* default index if none provided */
8050
8051  leftv u = v; int factorsGiven = 0;
8052  if ((u == NULL) || (u->Typ() != POLY_CMD))
8053  {
8054    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8055    return TRUE;
8056  }
8057  else h = (poly)u->Data();
8058  u = u->next;
8059  if ((u == NULL) || (u->Typ() != INT_CMD))
8060  {
8061    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8062    return TRUE;
8063  }
8064  else d = (int)(long)u->Data();
8065  u = u->next;
8066  if ((u != NULL) && (u->Typ() == POLY_CMD))
8067  {
8068    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
8069    {
8070      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8071      return TRUE;
8072    }
8073    else
8074    {
8075      f0 = (poly)u->Data();
8076      g0 = (poly)u->next->Data();
8077      factorsGiven = 1;
8078      u = u->next->next;
8079    }
8080  }
8081  if ((u != NULL) && (u->Typ() == INT_CMD))
8082  {
8083    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
8084    {
8085      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8086      return TRUE;
8087    }
8088    else
8089    {
8090      xIndex = (int)(long)u->Data();
8091      yIndex = (int)(long)u->next->Data();
8092      u = u->next->next;
8093    }
8094  }
8095  if (u != NULL)
8096  {
8097    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8098    return TRUE;
8099  }
8100
8101  /* checks for provided arguments */
8102  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
8103  {
8104    WerrorS("expected non-constant polynomial argument(s)");
8105    return TRUE;
8106  }
8107  int n = rVar(currRing);
8108  if ((xIndex < 1) || (n < xIndex))
8109  {
8110    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
8111    return TRUE;
8112  }
8113  if ((yIndex < 1) || (n < yIndex))
8114  {
8115    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
8116    return TRUE;
8117  }
8118  if (xIndex == yIndex)
8119  {
8120    WerrorS("expected distinct indices for variables x and y");
8121    return TRUE;
8122  }
8123
8124  /* computation of f0 and g0 if missing */
8125  if (factorsGiven == 0)
8126  {
8127    poly h0 = pSubst(pCopy(h), xIndex, NULL);
8128    intvec* v = NULL;
8129    ideal i = singclap_factorize(h0, &v, 0,currRing);
8130
8131    ivTest(v);
8132
8133    if (i == NULL) return TRUE;
8134
8135    idTest(i);
8136
8137    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
8138    {
8139      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
8140      return TRUE;
8141    }
8142    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
8143    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
8144    idDelete(&i);
8145  }
8146
8147  poly f; poly g;
8148  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
8149  lists L = (lists)omAllocBin(slists_bin);
8150  L->Init(2);
8151  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
8152  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
8153  res->rtyp = LIST_CMD;
8154  res->data = (char*)L;
8155  return FALSE;
8156}
8157static BOOLEAN jjSTATUS_M(leftv res, leftv v)
8158{
8159  if ((v->Typ() != LINK_CMD) ||
8160      (v->next->Typ() != STRING_CMD) ||
8161      (v->next->next->Typ() != STRING_CMD) ||
8162      (v->next->next->next->Typ() != INT_CMD))
8163    return TRUE;
8164  jjSTATUS3(res, v, v->next, v->next->next);
8165#if defined(HAVE_USLEEP)
8166  if (((long) res->data) == 0L)
8167  {
8168    int i_s = (int)(long) v->next->next->next->Data();
8169    if (i_s > 0)
8170    {
8171      usleep((int)(long) v->next->next->next->Data());
8172      jjSTATUS3(res, v, v->next, v->next->next);
8173    }
8174  }
8175#elif defined(HAVE_SLEEP)
8176  if (((int) res->data) == 0)
8177  {
8178    int i_s = (int) v->next->next->next->Data();
8179    if (i_s > 0)
8180    {
8181      si_sleep((is - 1)/1000000 + 1);
8182      jjSTATUS3(res, v, v->next, v->next->next);
8183    }
8184  }
8185#endif
8186  return FALSE;
8187}
8188static BOOLEAN jjSUBST_M(leftv res, leftv u)
8189{
8190  leftv v = u->next; // number of args > 0
8191  if (v==NULL) return TRUE;
8192  leftv w = v->next;
8193  if (w==NULL) return TRUE;
8194  leftv rest = w->next;
8195
8196  u->next = NULL;
8197  v->next = NULL;
8198  w->next = NULL;
8199  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
8200  if ((rest!=NULL) && (!b))
8201  {
8202    sleftv tmp_res;
8203    leftv tmp_next=res->next;
8204    res->next=rest;
8205    memset(&tmp_res,0,sizeof(tmp_res));
8206    b = iiExprArithM(&tmp_res,res,iiOp);
8207    memcpy(res,&tmp_res,sizeof(tmp_res));
8208    res->next=tmp_next;
8209  }
8210  u->next = v;
8211  v->next = w;
8212  // rest was w->next, but is already cleaned
8213  return b;
8214}
8215static BOOLEAN jjQRDS(leftv res, leftv INPUT)
8216{
8217  if ((INPUT->Typ() != MATRIX_CMD) ||
8218      (INPUT->next->Typ() != NUMBER_CMD) ||
8219      (INPUT->next->next->Typ() != NUMBER_CMD) ||
8220      (INPUT->next->next->next->Typ() != NUMBER_CMD))
8221  {
8222    WerrorS("expected (matrix, number, number, number) as arguments");
8223    return TRUE;
8224  }
8225  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
8226  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
8227                                    (number)(v->Data()),
8228                                    (number)(w->Data()),
8229                                    (number)(x->Data()));
8230  return FALSE;
8231}
8232static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
8233{ ideal result;
8234  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
8235  leftv v = u->next;  /* one additional polynomial or ideal */
8236  leftv h = v->next;  /* Hilbert vector */
8237  leftv w = h->next;  /* weight vector */
8238  assumeStdFlag(u);
8239  ideal i1=(ideal)(u->Data());
8240  ideal i0;
8241  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
8242  || (h->Typ()!=INTVEC_CMD)
8243  || (w->Typ()!=INTVEC_CMD))
8244  {
8245    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8246    return TRUE;
8247  }
8248  intvec *vw=(intvec *)w->Data(); // weights of vars
8249  /* merging std_hilb_w and std_1 */
8250  if (vw->length()!=currRing->N)
8251  {
8252    Werror("%d weights for %d variables",vw->length(),currRing->N);
8253    return TRUE;
8254  }
8255  int r=v->Typ();
8256  BOOLEAN cleanup_i0=FALSE;
8257  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
8258  {
8259    i0=idInit(1,i1->rank);
8260    i0->m[0]=(poly)v->Data();
8261    cleanup_i0=TRUE;
8262  }
8263  else if (r==IDEAL_CMD)/* IDEAL */
8264  {
8265    i0=(ideal)v->Data();
8266  }
8267  else
8268  {
8269    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8270    return TRUE;
8271  }
8272  int ii0=idElem(i0);
8273  i1 = idSimpleAdd(i1,i0);
8274  if (cleanup_i0)
8275  {
8276    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
8277    idDelete(&i0);
8278  }
8279  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8280  tHomog hom=testHomog;
8281  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
8282  if (ww!=NULL)
8283  {
8284    if (!idTestHomModule(i1,currRing->qideal,ww))
8285    {
8286      WarnS("wrong weights");
8287      ww=NULL;
8288    }
8289    else
8290    {
8291      ww=ivCopy(ww);
8292      hom=isHomog;
8293    }
8294  }
8295  BITSET save1;
8296  SI_SAVE_OPT1(save1);
8297  si_opt_1|=Sy_bit(OPT_SB_1);
8298  result=kStd(i1,
8299              currRing->qideal,
8300              hom,
8301              &ww,                  // module weights
8302              (intvec *)h->Data(),  // hilbert series
8303              0,                    // syzComp, whatever it is...
8304              IDELEMS(i1)-ii0,      // new ideal
8305              vw);                  // weights of vars
8306  SI_RESTORE_OPT1(save1);
8307  idDelete(&i1);
8308  idSkipZeroes(result);
8309  res->data = (char *)result;
8310  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
8311  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
8312  return FALSE;
8313}
8314
8315static BOOLEAN jjRING_PL(leftv res, leftv a)
8316{
8317  //Print("construct ring\n");
8318  if (a->Typ()!=CRING_CMD)
8319  {
8320    WerrorS("expected `cring` [ `id` ... ]");
8321    return TRUE;
8322  }
8323  assume(a->next!=NULL);
8324  leftv names=a->next;
8325  int N=names->listLength();
8326  char **n=(char**)omAlloc0(N*sizeof(char*));
8327  for(int i=0; i<N;i++,names=names->next)
8328  {
8329    n[i]=(char *)names->Name();
8330  }
8331  coeffs cf=(coeffs)a->CopyD();
8332  res->data=rDefault(cf,N,n, ringorder_dp);
8333  omFreeSize(n,N*sizeof(char*));
8334  return FALSE;
8335}
8336
8337static Subexpr jjMakeSub(leftv e)
8338{
8339  assume( e->Typ()==INT_CMD );
8340  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
8341  r->start =(int)(long)e->Data();
8342  return r;
8343}
8344static BOOLEAN jjRESTART(leftv, leftv u)
8345{
8346  int c=(int)(long)u->Data();
8347  switch(c)
8348  {
8349    case 0:{
8350        PrintS("delete all variables\n");
8351        killlocals(0);
8352        WerrorS("restarting...");
8353        break;
8354      };
8355    default: WerrorS("not implemented");
8356  }
8357  return FALSE;
8358}
8359#define D(A)    (A)
8360#define NULL_VAL NULL
8361#define IPARITH
8362#include "table.h"
8363
8364#include "iparith.inc"
8365
8366/*=================== operations with 2 args. ============================*/
8367/* must be ordered: first operations for chars (infix ops),
8368 * then alphabetically */
8369
8370static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
8371                                    BOOLEAN proccall,
8372                                    const struct sValCmd2* dA2,
8373                                    int at, int bt,
8374                                    const struct sConvertTypes *dConvertTypes)
8375{
8376  memset(res,0,sizeof(sleftv));
8377  BOOLEAN call_failed=FALSE;
8378
8379  if (!errorreported)
8380  {
8381    int i=0;
8382    iiOp=op;
8383    while (dA2[i].cmd==op)
8384    {
8385      if ((at==dA2[i].arg1)
8386      && (bt==dA2[i].arg2))
8387      {
8388        res->rtyp=dA2[i].res;
8389        if (currRing!=NULL)
8390        {
8391          if (check_valid(dA2[i].valid_for,op)) break;
8392        }
8393        else
8394        {
8395          if (RingDependend(dA2[i].res))
8396          {
8397            WerrorS("no ring active (3)");
8398            break;
8399          }
8400        }
8401        if (traceit&TRACE_CALL)
8402          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
8403        if ((call_failed=dA2[i].p(res,a,b)))
8404        {
8405          break;// leave loop, goto error handling
8406        }
8407        a->CleanUp();
8408        b->CleanUp();
8409        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8410        return FALSE;
8411      }
8412      i++;
8413    }
8414    // implicite type conversion ----------------------------------------------
8415    if (dA2[i].cmd!=op)
8416    {
8417      int ai,bi;
8418      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8419      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8420      BOOLEAN failed=FALSE;
8421      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8422      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8423      while (dA2[i].cmd==op)
8424      {
8425        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8426        if ((dA2[i].valid_for & NO_CONVERSION)==0)
8427        {
8428          if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8429          {
8430            if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8431            {
8432              res->rtyp=dA2[i].res;
8433              if (currRing!=NULL)
8434              {
8435                if (check_valid(dA2[i].valid_for,op)) break;
8436              }
8437              else
8438              {
8439                if (RingDependend(dA2[i].res))
8440                {
8441                  WerrorS("no ring active (4)");
8442                  break;
8443                }
8444              }
8445              if (traceit&TRACE_CALL)
8446                Print("call %s(%s,%s)\n",iiTwoOps(op),
8447                Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8448              failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8449              || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8450              || (call_failed=dA2[i].p(res,an,bn)));
8451              // everything done, clean up temp. variables
8452              if (failed)
8453              {
8454                // leave loop, goto error handling
8455                break;
8456              }
8457              else
8458              {
8459                // everything ok, clean up and return
8460                an->CleanUp();
8461                bn->CleanUp();
8462                omFreeBin((ADDRESS)an, sleftv_bin);
8463                omFreeBin((ADDRESS)bn, sleftv_bin);
8464                return FALSE;
8465              }
8466            }
8467          }
8468        }
8469        i++;
8470      }
8471      an->CleanUp();
8472      bn->CleanUp();
8473      omFreeBin((ADDRESS)an, sleftv_bin);
8474      omFreeBin((ADDRESS)bn, sleftv_bin);
8475    }
8476    // error handling ---------------------------------------------------
8477    const char *s=NULL;
8478    if (!errorreported)
8479    {
8480      if ((at==0) && (a->Fullname()!=sNoName_fe))
8481      {
8482        s=a->Fullname();
8483      }
8484      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8485      {
8486        s=b->Fullname();
8487      }
8488      if (s!=NULL)
8489        Werror("`%s` is not defined",s);
8490      else
8491      {
8492        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8493        s = iiTwoOps(op);
8494        if (proccall)
8495        {
8496          Werror("%s(`%s`,`%s`) failed"
8497                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8498        }
8499        else
8500        {
8501          Werror("`%s` %s `%s` failed"
8502                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8503        }
8504        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8505        {
8506          while (dA2[i].cmd==op)
8507          {
8508            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8509            && (dA2[i].res!=0)
8510            && (dA2[i].p!=jjWRONG2))
8511            {
8512              if (proccall)
8513                Werror("expected %s(`%s`,`%s`)"
8514                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8515              else
8516                Werror("expected `%s` %s `%s`"
8517                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8518            }
8519            i++;
8520          }
8521        }
8522      }
8523    }
8524    a->CleanUp();
8525    b->CleanUp();
8526    res->rtyp = UNKNOWN;
8527  }
8528  return TRUE;
8529}
8530BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8531                                    const struct sValCmd2* dA2,
8532                                    int at,
8533                                    const struct sConvertTypes *dConvertTypes)
8534{
8535  leftv b=a->next;
8536  a->next=NULL;
8537  int bt=b->Typ();
8538  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8539  a->next=b;
8540  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8541  return bo;
8542}
8543BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8544{
8545  memset(res,0,sizeof(sleftv));
8546
8547  if (!errorreported)
8548  {
8549#ifdef SIQ
8550    if (siq>0)
8551    {
8552      //Print("siq:%d\n",siq);
8553      command d=(command)omAlloc0Bin(sip_command_bin);
8554      memcpy(&d->arg1,a,sizeof(sleftv));
8555      a->Init();
8556      memcpy(&d->arg2,b,sizeof(sleftv));
8557      b->Init();
8558      d->argc=2;
8559      d->op=op;
8560      res->data=(char *)d;
8561      res->rtyp=COMMAND;
8562      return FALSE;
8563    }
8564#endif
8565    int at=a->Typ();
8566    int bt=b->Typ();
8567    // handling bb-objects ----------------------------------------------------
8568    if (at>MAX_TOK)
8569    {
8570      blackbox *bb=getBlackboxStuff(at);
8571      if (bb!=NULL)
8572      {
8573        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8574        //else: no op defined, try the default
8575      }
8576      else
8577      return TRUE;
8578    }
8579    else if ((bt>MAX_TOK)&&(op!='('))
8580    {
8581      blackbox *bb=getBlackboxStuff(bt);
8582      if (bb!=NULL)
8583      {
8584        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8585        // else: no op defined
8586      }
8587      else
8588      return TRUE;
8589    }
8590    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8591    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8592  }
8593  a->CleanUp();
8594  b->CleanUp();
8595  return TRUE;
8596}
8597
8598/*==================== operations with 1 arg. ===============================*/
8599/* must be ordered: first operations for chars (infix ops),
8600 * then alphabetically */
8601
8602BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, const struct sValCmd1* dA1, int at, const struct sConvertTypes *dConvertTypes)
8603{
8604  memset(res,0,sizeof(sleftv));
8605  BOOLEAN call_failed=FALSE;
8606
8607  if (!errorreported)
8608  {
8609    BOOLEAN failed=FALSE;
8610    iiOp=op;
8611    int i = 0;
8612    while (dA1[i].cmd==op)
8613    {
8614      if (at==dA1[i].arg)
8615      {
8616        if (currRing!=NULL)
8617        {
8618          if (check_valid(dA1[i].valid_for,op)) break;
8619        }
8620        else
8621        {
8622          if (RingDependend(dA1[i].res))
8623          {
8624            WerrorS("no ring active (5)");
8625            break;
8626          }
8627        }
8628        if (traceit&TRACE_CALL)
8629          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8630        res->rtyp=dA1[i].res;
8631        if ((call_failed=dA1[i].p(res,a)))
8632        {
8633          break;// leave loop, goto error handling
8634        }
8635        if (a->Next()!=NULL)
8636        {
8637          res->next=(leftv)omAllocBin(sleftv_bin);
8638          failed=iiExprArith1(res->next,a->next,op);
8639        }
8640        a->CleanUp();
8641        return failed;
8642      }
8643      i++;
8644    }
8645    // implicite type conversion --------------------------------------------
8646    if (dA1[i].cmd!=op)
8647    {
8648      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8649      i=0;
8650      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8651      while (dA1[i].cmd==op)
8652      {
8653        int ai;
8654        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8655        if ((dA1[i].valid_for & NO_CONVERSION)==0)
8656        {
8657          if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8658          {
8659            if (currRing!=NULL)
8660            {
8661              if (check_valid(dA1[i].valid_for,op)) break;
8662            }
8663            else
8664            {
8665              if (RingDependend(dA1[i].res))
8666              {
8667                WerrorS("no ring active (6)");
8668                break;
8669              }
8670            }
8671            if (traceit&TRACE_CALL)
8672              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8673            res->rtyp=dA1[i].res;
8674            failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8675            || (call_failed=dA1[i].p(res,an)));
8676            // everything done, clean up temp. variables
8677            if (failed)
8678            {
8679              // leave loop, goto error handling
8680              break;
8681            }
8682            else
8683            {
8684              if (an->Next() != NULL)
8685              {
8686                res->next = (leftv)omAllocBin(sleftv_bin);
8687                failed=iiExprArith1(res->next,an->next,op);
8688              }
8689              // everything ok, clean up and return
8690              an->CleanUp();
8691              omFreeBin((ADDRESS)an, sleftv_bin);
8692              return failed;
8693            }
8694          }
8695        }
8696        i++;
8697      }
8698      an->CleanUp();
8699      omFreeBin((ADDRESS)an, sleftv_bin);
8700    }
8701    // error handling
8702    if (!errorreported)
8703    {
8704      if ((at==0) && (a->Fullname()!=sNoName_fe))
8705      {
8706        Werror("`%s` is not defined",a->Fullname());
8707      }
8708      else
8709      {
8710        i=0;
8711        const char *s = iiTwoOps(op);
8712        Werror("%s(`%s`) failed"
8713                ,s,Tok2Cmdname(at));
8714        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8715        {
8716          while (dA1[i].cmd==op)
8717          {
8718            if ((dA1[i].res!=0)
8719            && (dA1[i].p!=jjWRONG))
8720              Werror("expected %s(`%s`)"
8721                ,s,Tok2Cmdname(dA1[i].arg));
8722            i++;
8723          }
8724        }
8725      }
8726    }
8727    res->rtyp = UNKNOWN;
8728  }
8729  a->CleanUp();
8730  return TRUE;
8731}
8732BOOLEAN iiExprArith1(leftv res, leftv a, int op)
8733{
8734  memset(res,0,sizeof(sleftv));
8735
8736  if (!errorreported)
8737  {
8738#ifdef SIQ
8739    if (siq>0)
8740    {
8741      //Print("siq:%d\n",siq);
8742      command d=(command)omAlloc0Bin(sip_command_bin);
8743      memcpy(&d->arg1,a,sizeof(sleftv));
8744      a->Init();
8745      d->op=op;
8746      d->argc=1;
8747      res->data=(char *)d;
8748      res->rtyp=COMMAND;
8749      return FALSE;
8750    }
8751#endif
8752    int at=a->Typ();
8753    // handling bb-objects ----------------------------------------------------
8754    if(op>MAX_TOK) // explicit type conversion to bb
8755    {
8756      blackbox *bb=getBlackboxStuff(op);
8757      if (bb!=NULL)
8758      {
8759        res->rtyp=op;
8760        res->data=bb->blackbox_Init(bb);
8761        if(!bb->blackbox_Assign(res,a)) return FALSE;
8762      }
8763      else
8764      return TRUE;
8765    }
8766    else if (at>MAX_TOK) // argument is of bb-type
8767    {
8768      blackbox *bb=getBlackboxStuff(at);
8769      if (bb!=NULL)
8770      {
8771        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
8772        // else: no op defined
8773      }
8774      else
8775      return TRUE;
8776    }
8777    if (errorreported) return TRUE;
8778
8779    iiOp=op;
8780    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8781    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
8782  }
8783  a->CleanUp();
8784  return TRUE;
8785}
8786
8787/*=================== operations with 3 args. ============================*/
8788/* must be ordered: first operations for chars (infix ops),
8789 * then alphabetically */
8790
8791static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
8792  const struct sValCmd3* dA3, int at, int bt, int ct,
8793  const struct sConvertTypes *dConvertTypes)
8794{
8795  memset(res,0,sizeof(sleftv));
8796  BOOLEAN call_failed=FALSE;
8797
8798  assume(dA3[0].cmd==op);
8799
8800  if (!errorreported)
8801  {
8802    int i=0;
8803    iiOp=op;
8804    while (dA3[i].cmd==op)
8805    {
8806      if ((at==dA3[i].arg1)
8807      && (bt==dA3[i].arg2)
8808      && (ct==dA3[i].arg3))
8809      {
8810        res->rtyp=dA3[i].res;
8811        if (currRing!=NULL)
8812        {
8813          if (check_valid(dA3[i].valid_for,op)) break;
8814        }
8815        if (traceit&TRACE_CALL)
8816          Print("call %s(%s,%s,%s)\n",
8817            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8818        if ((call_failed=dA3[i].p(res,a,b,c)))
8819        {
8820          break;// leave loop, goto error handling
8821        }
8822        a->CleanUp();
8823        b->CleanUp();
8824        c->CleanUp();
8825        return FALSE;
8826      }
8827      i++;
8828    }
8829    // implicite type conversion ----------------------------------------------
8830    if (dA3[i].cmd!=op)
8831    {
8832      int ai,bi,ci;
8833      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8834      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8835      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8836      BOOLEAN failed=FALSE;
8837      i=0;
8838      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8839      while (dA3[i].cmd==op)
8840      {
8841        if ((dA3[i].valid_for & NO_CONVERSION)==0)
8842        {
8843          if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
8844          {
8845            if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
8846            {
8847              if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
8848              {
8849                res->rtyp=dA3[i].res;
8850                if (currRing!=NULL)
8851                {
8852                  if (check_valid(dA3[i].valid_for,op)) break;
8853                }
8854                if (traceit&TRACE_CALL)
8855                  Print("call %s(%s,%s,%s)\n",
8856                    iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
8857                    Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
8858                failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
8859                  || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
8860                  || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
8861                  || (call_failed=dA3[i].p(res,an,bn,cn)));
8862                // everything done, clean up temp. variables
8863                if (failed)
8864                {
8865                  // leave loop, goto error handling
8866                  break;
8867                }
8868                else
8869                {
8870                  // everything ok, clean up and return
8871                  an->CleanUp();
8872                  bn->CleanUp();
8873                  cn->CleanUp();
8874                  omFreeBin((ADDRESS)an, sleftv_bin);
8875                  omFreeBin((ADDRESS)bn, sleftv_bin);
8876                  omFreeBin((ADDRESS)cn, sleftv_bin);
8877                  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8878                  return FALSE;
8879                }
8880              }
8881            }
8882          }
8883        }
8884        i++;
8885      }
8886      an->CleanUp();
8887      bn->CleanUp();
8888      cn->CleanUp();
8889      omFreeBin((ADDRESS)an, sleftv_bin);
8890      omFreeBin((ADDRESS)bn, sleftv_bin);
8891      omFreeBin((ADDRESS)cn, sleftv_bin);
8892    }
8893    // error handling ---------------------------------------------------
8894    if (!errorreported)
8895    {
8896      const char *s=NULL;
8897      if ((at==0) && (a->Fullname()!=sNoName_fe))
8898      {
8899        s=a->Fullname();
8900      }
8901      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8902      {
8903        s=b->Fullname();
8904      }
8905      else if ((ct==0) && (c->Fullname()!=sNoName_fe))
8906      {
8907        s=c->Fullname();
8908      }
8909      if (s!=NULL)
8910        Werror("`%s` is not defined",s);
8911      else
8912      {
8913        i=0;
8914        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8915        const char *s = iiTwoOps(op);
8916        Werror("%s(`%s`,`%s`,`%s`) failed"
8917                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8918        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8919        {
8920          while (dA3[i].cmd==op)
8921          {
8922            if(((at==dA3[i].arg1)
8923            ||(bt==dA3[i].arg2)
8924            ||(ct==dA3[i].arg3))
8925            && (dA3[i].res!=0))
8926            {
8927              Werror("expected %s(`%s`,`%s`,`%s`)"
8928                  ,s,Tok2Cmdname(dA3[i].arg1)
8929                  ,Tok2Cmdname(dA3[i].arg2)
8930                  ,Tok2Cmdname(dA3[i].arg3));
8931            }
8932            i++;
8933          }
8934        }
8935      }
8936    }
8937    res->rtyp = UNKNOWN;
8938  }
8939  a->CleanUp();
8940  b->CleanUp();
8941  c->CleanUp();
8942  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8943  return TRUE;
8944}
8945BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8946{
8947  memset(res,0,sizeof(sleftv));
8948
8949  if (!errorreported)
8950  {
8951#ifdef SIQ
8952    if (siq>0)
8953    {
8954      //Print("siq:%d\n",siq);
8955      command d=(command)omAlloc0Bin(sip_command_bin);
8956      memcpy(&d->arg1,a,sizeof(sleftv));
8957      a->Init();
8958      memcpy(&d->arg2,b,sizeof(sleftv));
8959      b->Init();
8960      memcpy(&d->arg3,c,sizeof(sleftv));
8961      c->Init();
8962      d->op=op;
8963      d->argc=3;
8964      res->data=(char *)d;
8965      res->rtyp=COMMAND;
8966      return FALSE;
8967    }
8968#endif
8969    int at=a->Typ();
8970    // handling bb-objects ----------------------------------------------
8971    if (at>MAX_TOK)
8972    {
8973      blackbox *bb=getBlackboxStuff(at);
8974      if (bb!=NULL)
8975      {
8976        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8977        // else: no op defined
8978      }
8979      else
8980      return TRUE;
8981      if (errorreported) return TRUE;
8982    }
8983    int bt=b->Typ();
8984    int ct=c->Typ();
8985
8986    iiOp=op;
8987    int i=0;
8988    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8989    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8990  }
8991  a->CleanUp();
8992  b->CleanUp();
8993  c->CleanUp();
8994  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8995  return TRUE;
8996}
8997BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
8998                                    const struct sValCmd3* dA3,
8999                                    int at,
9000                                    const struct sConvertTypes *dConvertTypes)
9001{
9002  leftv b=a->next;
9003  a->next=NULL;
9004  int bt=b->Typ();
9005  leftv c=b->next;
9006  b->next=NULL;
9007  int ct=c->Typ();
9008  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9009  b->next=c;
9010  a->next=b;
9011  a->CleanUp(); // to cleanup the chain, content already done
9012  return bo;
9013}
9014/*==================== operations with many arg. ===============================*/
9015/* must be ordered: first operations for chars (infix ops),
9016 * then alphabetically */
9017
9018#if 0 // unused
9019static BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
9020{
9021  // cnt = 0: all
9022  // cnt = 1: only first one
9023  leftv next;
9024  BOOLEAN failed = TRUE;
9025  if(v==NULL) return failed;
9026  res->rtyp = LIST_CMD;
9027  if(cnt) v->next = NULL;
9028  next = v->next;             // saving next-pointer
9029  failed = jjLIST_PL(res, v);
9030  v->next = next;             // writeback next-pointer
9031  return failed;
9032}
9033#endif
9034
9035BOOLEAN iiExprArithM(leftv res, leftv a, int op)
9036{
9037  memset(res,0,sizeof(sleftv));
9038
9039  if (!errorreported)
9040  {
9041#ifdef SIQ
9042    if (siq>0)
9043    {
9044      //Print("siq:%d\n",siq);
9045      command d=(command)omAlloc0Bin(sip_command_bin);
9046      d->op=op;
9047      res->data=(char *)d;
9048      if (a!=NULL)
9049      {
9050        d->argc=a->listLength();
9051        // else : d->argc=0;
9052        memcpy(&d->arg1,a,sizeof(sleftv));
9053        switch(d->argc)
9054        {
9055          case 3:
9056            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
9057            a->next->next->Init();
9058            /* no break */
9059          case 2:
9060            memcpy(&d->arg2,a->next,sizeof(sleftv));
9061            a->next->Init();
9062            a->next->next=d->arg2.next;
9063            d->arg2.next=NULL;
9064            /* no break */
9065          case 1:
9066            a->Init();
9067            a->next=d->arg1.next;
9068            d->arg1.next=NULL;
9069        }
9070        if (d->argc>3) a->next=NULL;
9071        a->name=NULL;
9072        a->rtyp=0;
9073        a->data=NULL;
9074        a->e=NULL;
9075        a->attribute=NULL;
9076        a->CleanUp();
9077      }
9078      res->rtyp=COMMAND;
9079      return FALSE;
9080    }
9081#endif
9082    if ((a!=NULL) && (a->Typ()>MAX_TOK))
9083    {
9084      blackbox *bb=getBlackboxStuff(a->Typ());
9085      if (bb!=NULL)
9086      {
9087        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
9088        // else: no op defined
9089      }
9090      else
9091      return TRUE;
9092      if (errorreported) return TRUE;
9093    }
9094    int args=0;
9095    if (a!=NULL) args=a->listLength();
9096
9097    iiOp=op;
9098    int i=0;
9099    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
9100    while (dArithM[i].cmd==op)
9101    {
9102      if ((args==dArithM[i].number_of_args)
9103      || (dArithM[i].number_of_args==-1)
9104      || ((dArithM[i].number_of_args==-2)&&(args>0)))
9105      {
9106        res->rtyp=dArithM[i].res;
9107        if (currRing!=NULL)
9108        {
9109          if (check_valid(dArithM[i].valid_for,op)) break;
9110        }
9111        if (traceit&TRACE_CALL)
9112          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
9113        if (dArithM[i].p(res,a))
9114        {
9115          break;// leave loop, goto error handling
9116        }
9117        if (a!=NULL) a->CleanUp();
9118        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9119        return FALSE;
9120      }
9121      i++;
9122    }
9123    // error handling
9124    if (!errorreported)
9125    {
9126      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName_fe))
9127      {
9128        Werror("`%s` is not defined",a->Fullname());
9129      }
9130      else
9131      {
9132        const char *s = iiTwoOps(op);
9133        Werror("%s(...) failed",s);
9134      }
9135    }
9136    res->rtyp = UNKNOWN;
9137  }
9138  if (a!=NULL) a->CleanUp();
9139        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9140  return TRUE;
9141}
9142
9143/*=================== general utilities ============================*/
9144int IsCmd(const char *n, int & tok)
9145{
9146  int i;
9147  int an=1;
9148  int en=sArithBase.nLastIdentifier;
9149
9150  loop
9151  //for(an=0; an<sArithBase.nCmdUsed; )
9152  {
9153    if(an>=en-1)
9154    {
9155      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9156      {
9157        i=an;
9158        break;
9159      }
9160      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9161      {
9162        i=en;
9163        break;
9164      }
9165      else
9166      {
9167        // -- blackbox extensions:
9168        // return 0;
9169        return blackboxIsCmd(n,tok);
9170      }
9171    }
9172    i=(an+en)/2;
9173    if (*n < *(sArithBase.sCmds[i].name))
9174    {
9175      en=i-1;
9176    }
9177    else if (*n > *(sArithBase.sCmds[i].name))
9178    {
9179      an=i+1;
9180    }
9181    else
9182    {
9183      int v=strcmp(n,sArithBase.sCmds[i].name);
9184      if(v<0)
9185      {
9186        en=i-1;
9187      }
9188      else if(v>0)
9189      {
9190        an=i+1;
9191      }
9192      else /*v==0*/
9193      {
9194        break;
9195      }
9196    }
9197  }
9198  lastreserved=sArithBase.sCmds[i].name;
9199  tok=sArithBase.sCmds[i].tokval;
9200  if(sArithBase.sCmds[i].alias==2)
9201  {
9202    Warn("outdated identifier `%s` used - please change your code",
9203    sArithBase.sCmds[i].name);
9204    sArithBase.sCmds[i].alias=1;
9205  }
9206  #if 0
9207  if (currRingHdl==NULL)
9208  {
9209    #ifdef SIQ
9210    if (siq<=0)
9211    {
9212    #endif
9213      if ((tok>=BEGIN_RING) && (tok<=END_RING))
9214      {
9215        WerrorS("no ring active");
9216        return 0;
9217      }
9218    #ifdef SIQ
9219    }
9220    #endif
9221  }
9222  #endif
9223  if (!expected_parms)
9224  {
9225    switch (tok)
9226    {
9227      case IDEAL_CMD:
9228      case INT_CMD:
9229      case INTVEC_CMD:
9230      case MAP_CMD:
9231      case MATRIX_CMD:
9232      case MODUL_CMD:
9233      case POLY_CMD:
9234      case PROC_CMD:
9235      case RING_CMD:
9236      case STRING_CMD:
9237        cmdtok = tok;
9238        break;
9239    }
9240  }
9241  return sArithBase.sCmds[i].toktype;
9242}
9243static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
9244{
9245  // user defined types are not in the pre-computed table:
9246  if (op>MAX_TOK) return 0;
9247
9248  int a=0;
9249  int e=len;
9250  int p=len/2;
9251  do
9252  {
9253     if (op==dArithTab[p].cmd) return dArithTab[p].start;
9254     if (op<dArithTab[p].cmd) e=p-1;
9255     else   a = p+1;
9256     p=a+(e-a)/2;
9257  }
9258  while ( a <= e);
9259
9260  // catch missing a cmd:
9261  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
9262  // Print("op %d (%c) unknown",op,op);
9263  return 0;
9264}
9265
9266typedef char si_char_2[2];
9267STATIC_VAR si_char_2 Tok2Cmdname_buf=" ";
9268const char * Tok2Cmdname(int tok)
9269{
9270  if (tok <= 0)
9271  {
9272    return sArithBase.sCmds[0].name;
9273  }
9274  if (tok==ANY_TYPE) return "any_type";
9275  if (tok==COMMAND) return "command";
9276  if (tok==NONE) return "nothing";
9277  if (tok < 128)
9278  {
9279    Tok2Cmdname_buf[1]=(char)tok;
9280    return Tok2Cmdname_buf;
9281  }
9282  //if (tok==IFBREAK) return "if_break";
9283  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
9284  //if (tok==ORDER_VECTOR) return "ordering";
9285  //if (tok==REF_VAR) return "ref";
9286  //if (tok==OBJECT) return "object";
9287  //if (tok==PRINT_EXPR) return "print_expr";
9288  if (tok==IDHDL) return "identifier";
9289  if (tok>MAX_TOK) return getBlackboxName(tok);
9290  unsigned i;
9291  for(i=0; i<sArithBase.nCmdUsed; i++)
9292    //while (sArithBase.sCmds[i].tokval!=0)
9293  {
9294    if ((sArithBase.sCmds[i].tokval == tok)&&
9295        (sArithBase.sCmds[i].alias==0))
9296    {
9297      return sArithBase.sCmds[i].name;
9298    }
9299  }
9300  // try gain for alias/old names:
9301  for(i=0; i<sArithBase.nCmdUsed; i++)
9302  {
9303    if (sArithBase.sCmds[i].tokval == tok)
9304    {
9305      return sArithBase.sCmds[i].name;
9306    }
9307  }
9308  return sArithBase.sCmds[0].name;
9309}
9310
9311
9312/*---------------------------------------------------------------------*/
9313/**
9314 * @brief compares to entry of cmdsname-list
9315
9316 @param[in] a
9317 @param[in] b
9318
9319 @return <ReturnValue>
9320**/
9321/*---------------------------------------------------------------------*/
9322static int _gentable_sort_cmds( const void *a, const void *b )
9323{
9324  cmdnames *pCmdL = (cmdnames*)a;
9325  cmdnames *pCmdR = (cmdnames*)b;
9326
9327  if(a==NULL || b==NULL)             return 0;
9328
9329  /* empty entries goes to the end of the list for later reuse */
9330  if(pCmdL->name==NULL) return 1;
9331  if(pCmdR->name==NULL) return -1;
9332
9333  /* $INVALID$ must come first */
9334  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
9335  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
9336
9337  /* tokval=-1 are reserved names at the end */
9338  if (pCmdL->tokval==-1)
9339  {
9340    if (pCmdR->tokval==-1)
9341       return strcmp(pCmdL->name, pCmdR->name);
9342    /* pCmdL->tokval==-1, pCmdL goes at the end */
9343    return 1;
9344  }
9345  /* pCmdR->tokval==-1, pCmdR goes at the end */
9346  if(pCmdR->tokval==-1) return -1;
9347
9348  return strcmp(pCmdL->name, pCmdR->name);
9349}
9350
9351/*---------------------------------------------------------------------*/
9352/**
9353 * @brief initialisation of arithmetic structured data
9354
9355 @retval 0 on success
9356
9357**/
9358/*---------------------------------------------------------------------*/
9359int iiInitArithmetic()
9360{
9361  //printf("iiInitArithmetic()\n");
9362  memset(&sArithBase, 0, sizeof(sArithBase));
9363  iiInitCmdName();
9364  /* fix last-identifier */
9365#if 0
9366  /* we expect that gentable allready did every thing */
9367  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9368      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
9369    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9370  }
9371#endif
9372  //Print("L=%d\n", sArithBase.nLastIdentifier);
9373
9374  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
9375  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
9376
9377  //iiArithAddCmd("Top", 0,-1,0);
9378
9379
9380  //for(i=0; i<sArithBase.nCmdUsed; i++) {
9381  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
9382  //         sArithBase.sCmds[i].name,
9383  //         sArithBase.sCmds[i].alias,
9384  //         sArithBase.sCmds[i].tokval,
9385  //         sArithBase.sCmds[i].toktype);
9386  //}
9387  //iiArithRemoveCmd("Top");
9388  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
9389  //iiArithRemoveCmd("mygcd");
9390  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
9391  return 0;
9392}
9393
9394int iiArithFindCmd(const char *szName)
9395{
9396  int an=0;
9397  int i = 0,v = 0;
9398  int en=sArithBase.nLastIdentifier;
9399
9400  loop
9401  //for(an=0; an<sArithBase.nCmdUsed; )
9402  {
9403    if(an>=en-1)
9404    {
9405      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
9406      {
9407        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
9408        return an;
9409      }
9410      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
9411      {
9412        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
9413        return en;
9414      }
9415      else
9416      {
9417        //Print("RET- 1\n");
9418        return -1;
9419      }
9420    }
9421    i=(an+en)/2;
9422    if (*szName < *(sArithBase.sCmds[i].name))
9423    {
9424      en=i-1;
9425    }
9426    else if (*szName > *(sArithBase.sCmds[i].name))
9427    {
9428      an=i+1;
9429    }
9430    else
9431    {
9432      v=strcmp(szName,sArithBase.sCmds[i].name);
9433      if(v<0)
9434      {
9435        en=i-1;
9436      }
9437      else if(v>0)
9438      {
9439        an=i+1;
9440      }
9441      else /*v==0*/
9442      {
9443        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9444        return i;
9445      }
9446    }
9447  }
9448  //if(i>=0 && i<sArithBase.nCmdUsed)
9449  //  return i;
9450  //PrintS("RET-2\n");
9451  return -2;
9452}
9453
9454char *iiArithGetCmd( int nPos )
9455{
9456  if(nPos<0) return NULL;
9457  if(nPos<(int)sArithBase.nCmdUsed)
9458    return sArithBase.sCmds[nPos].name;
9459  return NULL;
9460}
9461
9462int iiArithRemoveCmd(const char *szName)
9463{
9464  int nIndex;
9465  if(szName==NULL) return -1;
9466
9467  nIndex = iiArithFindCmd(szName);
9468  if(nIndex<0 || nIndex>=(int)sArithBase.nCmdUsed)
9469  {
9470    Print("'%s' not found (%d)\n", szName, nIndex);
9471    return -1;
9472  }
9473  omFree(sArithBase.sCmds[nIndex].name);
9474  sArithBase.sCmds[nIndex].name=NULL;
9475  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9476        (&_gentable_sort_cmds));
9477  sArithBase.nCmdUsed--;
9478
9479  /* fix last-identifier */
9480  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9481      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9482  {
9483    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9484  }
9485  //Print("L=%d\n", sArithBase.nLastIdentifier);
9486  return 0;
9487}
9488
9489int iiArithAddCmd(
9490  const char *szName,
9491  short nAlias,
9492  short nTokval,
9493  short nToktype,
9494  short nPos
9495  )
9496{
9497  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9498  //       nTokval, nToktype, nPos);
9499  if(nPos>=0)
9500  {
9501    // no checks: we rely on a correct generated code in iparith.inc
9502    assume((unsigned)nPos < sArithBase.nCmdAllocated);
9503    assume(szName!=NULL);
9504    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9505    sArithBase.sCmds[nPos].alias   = nAlias;
9506    sArithBase.sCmds[nPos].tokval  = nTokval;
9507    sArithBase.sCmds[nPos].toktype = nToktype;
9508    sArithBase.nCmdUsed++;
9509    //if(nTokval>0) sArithBase.nLastIdentifier++;
9510  }
9511  else
9512  {
9513    if(szName==NULL) return -1;
9514    int nIndex = iiArithFindCmd(szName);
9515    if(nIndex>=0)
9516    {
9517      Print("'%s' already exists at %d\n", szName, nIndex);
9518      return -1;
9519    }
9520
9521    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9522    {
9523      /* needs to create new slots */
9524      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9525      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9526      if(sArithBase.sCmds==NULL) return -1;
9527      sArithBase.nCmdAllocated++;
9528    }
9529    /* still free slots available */
9530    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9531    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9532    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9533    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9534    sArithBase.nCmdUsed++;
9535
9536    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9537          (&_gentable_sort_cmds));
9538    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9539        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9540    {
9541      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9542    }
9543    //Print("L=%d\n", sArithBase.nLastIdentifier);
9544  }
9545  return 0;
9546}
9547
9548static BOOLEAN check_valid(const int p, const int op)
9549{
9550  #ifdef HAVE_PLURAL
9551  if (rIsPluralRing(currRing))
9552  {
9553    if ((p & NC_MASK)==NO_NC)
9554    {
9555      WerrorS("not implemented for non-commutative rings");
9556      return TRUE;
9557    }
9558    else if ((p & NC_MASK)==COMM_PLURAL)
9559    {
9560      Warn("assume commutative subalgebra for cmd `%s` in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9561      return FALSE;
9562    }
9563    /* else, ALLOW_PLURAL */
9564  }
9565  #ifdef HAVE_SHIFTBBA
9566  else if (rIsLPRing(currRing))
9567  {
9568    if ((p & ALLOW_LP)==0)
9569    {
9570      Werror("`%s` not implemented for letterplace rings in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9571      return TRUE;
9572    }
9573  }
9574  #endif
9575  #endif
9576#ifdef HAVE_RINGS
9577  if (rField_is_Ring(currRing))
9578  {
9579    if ((p & RING_MASK)==0 /*NO_RING*/)
9580    {
9581      WerrorS("not implemented for rings with rings as coeffients");
9582      return TRUE;
9583    }
9584    /* else ALLOW_RING */
9585    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9586    &&(!rField_is_Domain(currRing)))
9587    {
9588      WerrorS("domain required as coeffients");
9589      return TRUE;
9590    }
9591    /* else ALLOW_ZERODIVISOR */
9592    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9593    {
9594      WarnS("considering the image in Q[...]");
9595    }
9596  }
9597#endif
9598  return FALSE;
9599}
9600// --------------------------------------------------------------------
9601static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
9602{
9603  if ((currRing!=NULL)
9604  && rField_is_Ring(currRing)
9605  && (!rField_is_Z(currRing)))
9606  {
9607    WerrorS("not implemented for rings with rings as coeffients (except ZZ)");
9608    return TRUE;
9609  }
9610  coeffs cf;
9611  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
9612  int rl=c->nr+1;
9613  int return_type=c->m[0].Typ();
9614  if ((return_type!=IDEAL_CMD)
9615  && (return_type!=MODUL_CMD)
9616  && (return_type!=MATRIX_CMD)
9617  && (return_type!=POLY_CMD))
9618  {
9619    if((return_type==BIGINT_CMD)
9620    ||(return_type==INT_CMD))
9621      return_type=BIGINT_CMD;
9622    else if (return_type==LIST_CMD)
9623    {
9624      // create a tmp list of the correct size
9625      lists res_l=(lists)omAllocBin(slists_bin);
9626      res_l->Init(rl /*c->nr+1*/);
9627      BOOLEAN bo=FALSE;
9628      int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,CHINREM_CMD);
9629      for (unsigned i=0;i<=(unsigned)c->nr;i++)
9630      {
9631        sleftv tmp;
9632        tmp.Copy(v);
9633        bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],CHINREM_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9634        if (bo) { Werror("chinrem failed for list entry %d",i+1); break;}
9635      }
9636      c->Clean();
9637      res->data=res_l;
9638      res->rtyp=LIST_CMD;
9639      return bo;
9640    }
9641    else
9642    {
9643      c->Clean();
9644      WerrorS("poly/ideal/module/matrix/list expected");
9645      return TRUE;
9646    }
9647  }
9648  if (return_type==BIGINT_CMD)
9649    cf=coeffs_BIGINT;
9650  else
9651  {
9652    cf=currRing->cf;
9653    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
9654      cf=cf->extRing->cf;
9655  }
9656  lists pl=NULL;
9657  intvec *p=NULL;
9658  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
9659  else                    p=(intvec*)v->Data();
9660  ideal result;
9661  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
9662  number *xx=NULL;
9663  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
9664  int i;
9665  if (return_type!=BIGINT_CMD)
9666  {
9667    for(i=rl-1;i>=0;i--)
9668    {
9669      if (c->m[i].Typ()!=return_type)
9670      {
9671        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
9672        omFree(x); // delete c
9673        return TRUE;
9674      }
9675      if (return_type==POLY_CMD)
9676      {
9677        x[i]=idInit(1,1);
9678        x[i]->m[0]=(poly)c->m[i].CopyD();
9679      }
9680      else
9681      {
9682        x[i]=(ideal)c->m[i].CopyD();
9683      }
9684      //c->m[i].Init();
9685    }
9686  }
9687  else
9688  {
9689    if (nMap==NULL)
9690    {
9691      Werror("not implemented: map bigint -> %s", nCoeffName(cf));
9692      return TRUE;
9693    }
9694    xx=(number *)omAlloc(rl*sizeof(number));
9695    for(i=rl-1;i>=0;i--)
9696    {
9697      if (c->m[i].Typ()==INT_CMD)
9698      {
9699        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
9700      }
9701      else if (c->m[i].Typ()==BIGINT_CMD)
9702      {
9703        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
9704      }
9705      else
9706      {
9707        Werror("bigint expected at pos %d",i+1);
9708        omFree(x); // delete c
9709        omFree(xx); // delete c
9710        return TRUE;
9711      }
9712    }
9713  }
9714  number *q=(number *)omAlloc(rl*sizeof(number));
9715  if (p!=NULL)
9716  {
9717    for(i=rl-1;i>=0;i--)
9718    {
9719      q[i]=n_Init((*p)[i], cf);
9720    }
9721  }
9722  else
9723  {
9724    for(i=rl-1;i>=0;i--)
9725    {
9726      if (pl->m[i].Typ()==INT_CMD)
9727      {
9728        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
9729      }
9730      else if (pl->m[i].Typ()==BIGINT_CMD)
9731      {
9732        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
9733      }
9734      else
9735      {
9736        Werror("bigint expected at pos %d",i+1);
9737        for(i++;i<rl;i++)
9738        {
9739          n_Delete(&(q[i]),cf);
9740        }
9741        omFree(x); // delete c
9742        omFree(q); // delete pl
9743        if (xx!=NULL) omFree(xx); // delete c
9744        return TRUE;
9745      }
9746    }
9747  }
9748  if (return_type==BIGINT_CMD)
9749  {
9750    CFArray i_v(rl);
9751    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,i_v,coeffs_BIGINT);
9752    res->data=(char *)n;
9753  }
9754  else
9755  {
9756    result=id_ChineseRemainder(x,q,rl,currRing); // deletes also x
9757    c->Clean();
9758    if ((return_type==POLY_CMD) &&(result!=NULL))
9759    {
9760      res->data=(char *)result->m[0];
9761      result->m[0]=NULL;
9762      idDelete(&result);
9763    }
9764    else
9765      res->data=(char *)result;
9766  }
9767  for(i=rl-1;i>=0;i--)
9768  {
9769    n_Delete(&(q[i]),cf);
9770  }
9771  omFree(q);
9772  res->rtyp=return_type;
9773  return result==NULL;
9774}
9775static BOOLEAN jjFAREY_LI(leftv res, leftv u, leftv v)
9776{
9777  lists c=(lists)u->CopyD();
9778  lists res_l=(lists)omAllocBin(slists_bin);
9779  res_l->Init(c->nr+1);
9780  BOOLEAN bo=FALSE;
9781  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,FAREY_CMD);
9782  for (unsigned i=0;i<=(unsigned)c->nr;i++)
9783  {
9784    sleftv tmp;
9785    tmp.Copy(v);
9786    bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],FAREY_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9787    if (bo) { Werror("farey failed for list entry %d",i+1); break;}
9788  }
9789  c->Clean();
9790  res->data=res_l;
9791  return bo;
9792}
9793// --------------------------------------------------------------------
9794static int jjCOMPARE_ALL(const void * aa, const void * bb)
9795{
9796  leftv a=(leftv)aa;
9797  int at=a->Typ();
9798  leftv b=(leftv)bb;
9799  int bt=b->Typ();
9800  if (at < bt) return -1;
9801  if (at > bt) return 1;
9802  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,'<');
9803  sleftv tmp;
9804  memset(&tmp,0,sizeof(sleftv));
9805  iiOp='<';
9806  BOOLEAN bo=iiExprArith2TabIntern(&tmp,a,'<',b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
9807  if (bo)
9808  {
9809    Werror(" no `<` for %s",Tok2Cmdname(at));
9810    unsigned long ad=(unsigned long)a->Data();
9811    unsigned long bd=(unsigned long)b->Data();
9812    if (ad<bd) return -1;
9813    else if (ad==bd) return 0;
9814    else return 1;
9815  }
9816  else if (tmp.data==NULL) /* not < */
9817  {
9818    iiOp=EQUAL_EQUAL;
9819    tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,EQUAL_EQUAL);
9820    bo=iiExprArith2TabIntern(&tmp,a,EQUAL_EQUAL,b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
9821    if (bo)
9822    {
9823      Werror(" no `==` for %s",Tok2Cmdname(at));
9824      unsigned long ad=(unsigned long)a->Data();
9825      unsigned long bd=(unsigned long)b->Data();
9826      if (ad<bd) return -1;
9827      else if (ad==bd) return 0;
9828      else return 1;
9829    }
9830    else if (tmp.data==NULL) /* not <,== */ return 1;
9831    else return 0;
9832  }
9833  else return -1;
9834}
9835BOOLEAN jjSORTLIST(leftv, leftv arg)
9836{
9837  lists l=(lists)arg->Data();
9838  if (l->nr>0)
9839  {
9840    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
9841  }
9842  return FALSE;
9843}
9844BOOLEAN jjUNIQLIST(leftv, leftv arg)
9845{
9846  lists l=(lists)arg->Data();
9847  if (l->nr>0)
9848  {
9849    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
9850    int i, j, len;
9851    len=l->nr;
9852    i=0;
9853    while(i<len)
9854    {
9855      if(jjCOMPARE_ALL(&(l->m[i]),&(l->m[i+1]))==0)
9856      {
9857        l->m[i].CleanUp();
9858        for(j=i; j<len;j++) l->m[j]=l->m[j+1];
9859        memset(&(l->m[len]),0,sizeof(sleftv));
9860        l->m[len].rtyp=DEF_CMD;
9861        len--;
9862      }
9863      else
9864        i++;
9865    }
9866    //Print("new len:%d\n",len);
9867  }
9868  return FALSE;
9869}
Note: See TracBrowser for help on using the repository browser.