source: git/Singular/iparith.cc @ da6d43a

fieker-DuValspielwiese
Last change on this file since da6d43a was 5de37f3, checked in by Hans Schoenemann <hannes@…>, 4 years ago
Merge pull request #967 from kabouzeid/lp_lift lift & liftstd for Letterplace
  • 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  unsigned save_opt=si_opt_1;
5110  si_opt_1 |= Sy_bit(OPT_REDTAIL_SYZ);
5111  ideal S=idSyzygies(v_id,hom,&w);
5112  si_opt_1=save_opt;
5113  res->data = (char *)S;
5114  if (hom==isHomog)
5115  {
5116    int vl=S->rank;
5117    intvec *vv=new intvec(vl);
5118    if ((v->Typ()==IDEAL_CMD)||(ww==NULL))
5119    {
5120      for(int i=0;i<vl;i++)
5121      {
5122        if (v_id->m[i]!=NULL)
5123          (*vv)[i]=p_Deg(v_id->m[i],currRing);
5124      }
5125    }
5126    else
5127    {
5128      p_SetModDeg(ww, currRing);
5129      for(int i=0;i<vl;i++)
5130      {
5131        if (v_id->m[i]!=NULL)
5132          (*vv)[i]=currRing->pFDeg(v_id->m[i],currRing);
5133      }
5134      p_SetModDeg(NULL, currRing);
5135    }
5136    if (idTestHomModule(S,currRing->qideal,vv))
5137      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
5138    else
5139      delete vv;
5140  }
5141  if (w!=NULL) delete w;
5142  return FALSE;
5143}
5144#endif
5145static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5146{
5147  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5148  return FALSE;
5149}
5150static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5151{
5152  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5153  return FALSE;
5154}
5155static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5156{
5157  res->data = (char *)ivTranp((intvec*)(v->Data()));
5158  return FALSE;
5159}
5160#ifdef HAVE_PLURAL
5161static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5162{
5163  ring    r = (ring)a->Data();
5164  //if (rIsPluralRing(r))
5165  if (r->OrdSgn==1)
5166  {
5167    res->data = rOpposite(r);
5168  }
5169  else
5170  {
5171    WarnS("opposite only for global orderings");
5172    res->data = rCopy(r);
5173  }
5174  return FALSE;
5175}
5176static BOOLEAN jjENVELOPE(leftv res, leftv a)
5177{
5178  ring    r = (ring)a->Data();
5179  if (rIsPluralRing(r))
5180  {
5181    ring s = rEnvelope(r);
5182    res->data = s;
5183  }
5184  else  res->data = rCopy(r);
5185  return FALSE;
5186}
5187static BOOLEAN jjTWOSTD(leftv res, leftv a)
5188{
5189  ideal result;
5190  ideal v_id=(ideal)a->Data();
5191  if (rIsPluralRing(currRing))
5192    result=(ideal)twostd(v_id);
5193  else /*commutative or shiftalgebra*/
5194  {
5195    return jjSTD(res,a);
5196  }
5197  res->data = (char *)result;
5198  setFlag(res,FLAG_STD);
5199  setFlag(res,FLAG_TWOSTD);
5200  return FALSE;
5201}
5202#endif
5203#if defined(HAVE_SHIFTBBA) || defined(HAVE_PLURAL)// do not place above jjSTD in this file because we need to reference it
5204static BOOLEAN jjRIGHTSTD(leftv res, leftv v)
5205{
5206  if (rIsLPRing(currRing))
5207  {
5208    if (rField_is_numeric(currRing))
5209      WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5210    ideal result;
5211    ideal v_id=(ideal)v->Data();
5212    /* intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD); */
5213    /* tHomog hom=testHomog; */
5214    /* if (w!=NULL) */
5215    /* { */
5216    /*   if (!idTestHomModule(v_id,currRing->qideal,w)) */
5217    /*   { */
5218    /*     WarnS("wrong weights"); */
5219    /*     w=NULL; */
5220    /*   } */
5221    /*   else */
5222    /*   { */
5223    /*     hom=isHomog; */
5224    /*     w=ivCopy(w); */
5225    /*   } */
5226    /* } */
5227    /* result=kStd(v_id,currRing->qideal,hom,&w); */
5228    result = rightgb(v_id, currRing->qideal);
5229    idSkipZeroes(result);
5230    res->data = (char *)result;
5231    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5232    /* if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD); */
5233    return FALSE;
5234  }
5235  else if (rIsPluralRing(currRing))
5236  {
5237    ideal I=(ideal)v->Data();
5238
5239    ring A = currRing;
5240    ring Aopp = rOpposite(A);
5241    currRing = Aopp;
5242    ideal Iopp = idOppose(A, I, Aopp);
5243    ideal Jopp = kStd(Iopp,currRing->qideal,testHomog,NULL);
5244    currRing = A;
5245    ideal J = idOppose(Aopp, Jopp, A);
5246
5247    id_Delete(&Iopp, Aopp);
5248    id_Delete(&Jopp, Aopp);
5249    rDelete(Aopp);
5250
5251    idSkipZeroes(J);
5252    res->data = (char *)J;
5253    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5254    return FALSE;
5255  }
5256  else
5257  {
5258    return jjSTD(res, v);
5259  }
5260}
5261#endif
5262static BOOLEAN jjTYPEOF(leftv res, leftv v)
5263{
5264  int t=(int)(long)v->data;
5265  switch (t)
5266  {
5267    case CRING_CMD:
5268    case INT_CMD:
5269    case POLY_CMD:
5270    case VECTOR_CMD:
5271    case STRING_CMD:
5272    case INTVEC_CMD:
5273    case IDEAL_CMD:
5274    case MATRIX_CMD:
5275    case MODUL_CMD:
5276    case MAP_CMD:
5277    case PROC_CMD:
5278    case RING_CMD:
5279    case SMATRIX_CMD:
5280    //case QRING_CMD:
5281    case INTMAT_CMD:
5282    case BIGINTMAT_CMD:
5283    case NUMBER_CMD:
5284    #ifdef SINGULAR_4_2
5285    case CNUMBER_CMD:
5286    #endif
5287    case BIGINT_CMD:
5288    case BUCKET_CMD:
5289    case LIST_CMD:
5290    case PACKAGE_CMD:
5291    case LINK_CMD:
5292    case RESOLUTION_CMD:
5293         res->data=omStrDup(Tok2Cmdname(t)); break;
5294    case DEF_CMD:
5295    case NONE:           res->data=omStrDup("none"); break;
5296    default:
5297    {
5298      if (t>MAX_TOK)
5299        res->data=omStrDup(getBlackboxName(t));
5300      else
5301        res->data=omStrDup("?unknown type?");
5302      break;
5303    }
5304  }
5305  return FALSE;
5306}
5307static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5308{
5309  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5310  return FALSE;
5311}
5312static BOOLEAN jjVAR1(leftv res, leftv v)
5313{
5314  int i=(int)(long)v->Data();
5315  if ((0<i) && (i<=currRing->N))
5316  {
5317    poly p=pOne();
5318    pSetExp(p,i,1);
5319    pSetm(p);
5320    res->data=(char *)p;
5321  }
5322  else
5323  {
5324    Werror("var number %d out of range 1..%d",i,currRing->N);
5325    return TRUE;
5326  }
5327  return FALSE;
5328}
5329static BOOLEAN jjVARSTR1(leftv res, leftv v)
5330{
5331  if (currRing==NULL)
5332  {
5333    WerrorS("no ring active (2)");
5334    return TRUE;
5335  }
5336  int i=(int)(long)v->Data();
5337  if ((0<i) && (i<=currRing->N))
5338    res->data=omStrDup(currRing->names[i-1]);
5339  else
5340  {
5341    Werror("var number %d out of range 1..%d",i,currRing->N);
5342    return TRUE;
5343  }
5344  return FALSE;
5345}
5346static BOOLEAN jjVDIM(leftv res, leftv v)
5347{
5348  assumeStdFlag(v);
5349  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5350  return FALSE;
5351}
5352BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5353{
5354// input: u: a list with links of type
5355//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5356// returns: -1:  the read state of all links is eof
5357//          i>0: (at least) u[i] is ready
5358  lists Lforks = (lists)u->Data();
5359  int i = slStatusSsiL(Lforks, -1);
5360  if(i == -2) /* error */
5361  {
5362    return TRUE;
5363  }
5364  res->data = (void*)(long)i;
5365  return FALSE;
5366}
5367BOOLEAN jjWAITALL1(leftv res, leftv u)
5368{
5369// input: u: a list with links of type
5370//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5371// returns: -1: the read state of all links is eof
5372//           1: all links are ready
5373//              (caution: at least one is ready, but some maybe dead)
5374  lists Lforks = (lists)u->CopyD();
5375  int i;
5376  int j = -1;
5377  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5378  {
5379    i = slStatusSsiL(Lforks, -1);
5380    if(i == -2) /* error */
5381    {
5382      return TRUE;
5383    }
5384    if(i == -1)
5385    {
5386      break;
5387    }
5388    j = 1;
5389    Lforks->m[i-1].CleanUp();
5390    Lforks->m[i-1].rtyp=DEF_CMD;
5391    Lforks->m[i-1].data=NULL;
5392  }
5393  res->data = (void*)(long)j;
5394  Lforks->Clean();
5395  return FALSE;
5396}
5397
5398BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5399{
5400  char libnamebuf[1024];
5401  lib_types LT = type_of_LIB(s, libnamebuf);
5402
5403#ifdef HAVE_DYNAMIC_LOADING
5404  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5405#endif /* HAVE_DYNAMIC_LOADING */
5406  switch(LT)
5407  {
5408      default:
5409      case LT_NONE:
5410        Werror("%s: unknown type", s);
5411        break;
5412      case LT_NOTFOUND:
5413        Werror("cannot open %s", s);
5414        break;
5415
5416      case LT_SINGULAR:
5417      {
5418        char *plib = iiConvName(s);
5419        idhdl pl = IDROOT->get_level(plib,0);
5420        if (pl==NULL)
5421        {
5422          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5423          IDPACKAGE(pl)->language = LANG_SINGULAR;
5424          IDPACKAGE(pl)->libname=omStrDup(s);
5425        }
5426        else if (IDTYP(pl)!=PACKAGE_CMD)
5427        {
5428          Werror("can not create package `%s`",plib);
5429          omFree(plib);
5430          return TRUE;
5431        }
5432        else /* package */
5433        {
5434          package pa=IDPACKAGE(pl);
5435          if ((pa->language==LANG_C)
5436          || (pa->language==LANG_MIX))
5437          {
5438            Werror("can not create package `%s` - binaries  exists",plib);
5439            omfree(plib);
5440            return TRUE;
5441          }
5442        }
5443        omFree(plib);
5444        package savepack=currPack;
5445        currPack=IDPACKAGE(pl);
5446        IDPACKAGE(pl)->loaded=TRUE;
5447        char libnamebuf[1024];
5448        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5449        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5450        currPack=savepack;
5451        IDPACKAGE(pl)->loaded=(!bo);
5452        return bo;
5453      }
5454      case LT_BUILTIN:
5455        SModulFunc_t iiGetBuiltinModInit(const char*);
5456        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5457      case LT_MACH_O:
5458      case LT_ELF:
5459      case LT_HPUX:
5460#ifdef HAVE_DYNAMIC_LOADING
5461        return load_modules(s, libnamebuf, autoexport);
5462#else /* HAVE_DYNAMIC_LOADING */
5463        WerrorS("Dynamic modules are not supported by this version of Singular");
5464        break;
5465#endif /* HAVE_DYNAMIC_LOADING */
5466  }
5467  return TRUE;
5468}
5469STATIC_VAR int WerrorS_dummy_cnt=0;
5470static void WerrorS_dummy(const char *)
5471{
5472  WerrorS_dummy_cnt++;
5473}
5474BOOLEAN jjLOAD_TRY(const char *s)
5475{
5476  if (!iiGetLibStatus(s))
5477  {
5478    void (*WerrorS_save)(const char *s) = WerrorS_callback;
5479    WerrorS_callback=WerrorS_dummy;
5480    WerrorS_dummy_cnt=0;
5481    BOOLEAN bo=jjLOAD(s,TRUE);
5482    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5483      Print("loading of >%s< failed\n",s);
5484    WerrorS_callback=WerrorS_save;
5485    errorreported=0;
5486  }
5487  return FALSE;
5488}
5489
5490static BOOLEAN jjstrlen(leftv res, leftv v)
5491{
5492  res->data = (char *)strlen((char *)v->Data());
5493  return FALSE;
5494}
5495static BOOLEAN jjpLength(leftv res, leftv v)
5496{
5497  res->data = (char *)(long)pLength((poly)v->Data());
5498  return FALSE;
5499}
5500static BOOLEAN jjidElem(leftv res, leftv v)
5501{
5502  res->data = (char *)(long)idElem((ideal)v->Data());
5503  return FALSE;
5504}
5505static BOOLEAN jjidFreeModule(leftv res, leftv v)
5506{
5507  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5508  return FALSE;
5509}
5510static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5511{
5512  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5513  return FALSE;
5514}
5515static BOOLEAN jjrCharStr(leftv res, leftv v)
5516{
5517  res->data = rCharStr((ring)v->Data());
5518  return FALSE;
5519}
5520static BOOLEAN jjpHead(leftv res, leftv v)
5521{
5522  res->data = (char *)pHead((poly)v->Data());
5523  return FALSE;
5524}
5525static BOOLEAN jjidHead(leftv res, leftv v)
5526{
5527  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5528  setFlag(res,FLAG_STD);
5529  return FALSE;
5530}
5531static BOOLEAN jjidMinBase(leftv res, leftv v)
5532{
5533  res->data = (char *)idMinBase((ideal)v->Data());
5534  return FALSE;
5535}
5536#if 0 // unused
5537static BOOLEAN jjsyMinBase(leftv res, leftv v)
5538{
5539  res->data = (char *)syMinBase((ideal)v->Data());
5540  return FALSE;
5541}
5542#endif
5543static BOOLEAN jjpMaxComp(leftv res, leftv v)
5544{
5545  res->data = (char *)pMaxComp((poly)v->Data());
5546  return FALSE;
5547}
5548static BOOLEAN jjmpTrace(leftv res, leftv v)
5549{
5550  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5551  return FALSE;
5552}
5553static BOOLEAN jjmpTransp(leftv res, leftv v)
5554{
5555  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5556  return FALSE;
5557}
5558static BOOLEAN jjrOrdStr(leftv res, leftv v)
5559{
5560  res->data = rOrdStr((ring)v->Data());
5561  return FALSE;
5562}
5563static BOOLEAN jjrVarStr(leftv res, leftv v)
5564{
5565  res->data = rVarStr((ring)v->Data());
5566  return FALSE;
5567}
5568static BOOLEAN jjrParStr(leftv res, leftv v)
5569{
5570  res->data = rParStr((ring)v->Data());
5571  return FALSE;
5572}
5573static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5574{
5575  res->data=(char *)(long)sySize((syStrategy)v->Data());
5576  return FALSE;
5577}
5578static BOOLEAN jjDIM_R(leftv res, leftv v)
5579{
5580  res->data = (char *)(long)syDim((syStrategy)v->Data());
5581  return FALSE;
5582}
5583static BOOLEAN jjidTransp(leftv res, leftv v)
5584{
5585  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5586  return FALSE;
5587}
5588static BOOLEAN jjnInt(leftv res, leftv u)
5589{
5590  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5591  res->data=(char *)(long)iin_Int(n,currRing->cf);
5592  n_Delete(&n,currRing->cf);
5593  return FALSE;
5594}
5595static BOOLEAN jjnlInt(leftv res, leftv u)
5596{
5597  number n=(number)u->Data();
5598  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5599  return FALSE;
5600}
5601/*=================== operations with 3 args.: static proc =================*/
5602/* must be ordered: first operations for chars (infix ops),
5603 * then alphabetically */
5604static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5605{
5606  char *s= (char *)u->Data();
5607  int   r = (int)(long)v->Data();
5608  int   c = (int)(long)w->Data();
5609  int l = strlen(s);
5610
5611  if ( (r<1) || (r>l) || (c<0) )
5612  {
5613    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5614    return TRUE;
5615  }
5616  res->data = (char *)omAlloc((long)(c+1));
5617  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5618  return FALSE;
5619}
5620static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5621{
5622  intvec *iv = (intvec *)u->Data();
5623  int   r = (int)(long)v->Data();
5624  int   c = (int)(long)w->Data();
5625  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5626  {
5627    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5628           r,c,u->Fullname(),iv->rows(),iv->cols());
5629    return TRUE;
5630  }
5631  res->data=u->data; u->data=NULL;
5632  res->rtyp=u->rtyp; u->rtyp=0;
5633  res->name=u->name; u->name=NULL;
5634  Subexpr e=jjMakeSub(v);
5635          e->next=jjMakeSub(w);
5636  if (u->e==NULL) res->e=e;
5637  else
5638  {
5639    Subexpr h=u->e;
5640    while (h->next!=NULL) h=h->next;
5641    h->next=e;
5642    res->e=u->e;
5643    u->e=NULL;
5644  }
5645  return FALSE;
5646}
5647static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5648{
5649  bigintmat *bim = (bigintmat *)u->Data();
5650  int   r = (int)(long)v->Data();
5651  int   c = (int)(long)w->Data();
5652  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5653  {
5654    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5655           r,c,u->Fullname(),bim->rows(),bim->cols());
5656    return TRUE;
5657  }
5658  res->data=u->data; u->data=NULL;
5659  res->rtyp=u->rtyp; u->rtyp=0;
5660  res->name=u->name; u->name=NULL;
5661  Subexpr e=jjMakeSub(v);
5662          e->next=jjMakeSub(w);
5663  if (u->e==NULL)
5664    res->e=e;
5665  else
5666  {
5667    Subexpr h=u->e;
5668    while (h->next!=NULL) h=h->next;
5669    h->next=e;
5670    res->e=u->e;
5671    u->e=NULL;
5672  }
5673  return FALSE;
5674}
5675static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5676{
5677  matrix m= (matrix)u->Data();
5678  int   r = (int)(long)v->Data();
5679  int   c = (int)(long)w->Data();
5680  //Print("gen. elem %d, %d\n",r,c);
5681  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5682  {
5683    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5684      MATROWS(m),MATCOLS(m));
5685    return TRUE;
5686  }
5687  res->data=u->data; u->data=NULL;
5688  res->rtyp=u->rtyp; u->rtyp=0;
5689  res->name=u->name; u->name=NULL;
5690  Subexpr e=jjMakeSub(v);
5691          e->next=jjMakeSub(w);
5692  if (u->e==NULL)
5693    res->e=e;
5694  else
5695  {
5696    Subexpr h=u->e;
5697    while (h->next!=NULL) h=h->next;
5698    h->next=e;
5699    res->e=u->e;
5700    u->e=NULL;
5701  }
5702  return FALSE;
5703}
5704static BOOLEAN jjBRACK_SM(leftv res, leftv u, leftv v,leftv w)
5705{
5706  ideal m= (ideal)u->Data();
5707  int   r = (int)(long)v->Data();
5708  int   c = (int)(long)w->Data();
5709  //Print("gen. elem %d, %d\n",r,c);
5710  if ((r<1)||(r>m->rank)||(c<1)||(c>IDELEMS(m)))
5711  {
5712    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5713      (int)m->rank,IDELEMS(m));
5714    return TRUE;
5715  }
5716  res->data=u->data; u->data=NULL;
5717  res->rtyp=u->rtyp; u->rtyp=0;
5718  res->name=u->name; u->name=NULL;
5719  Subexpr e=jjMakeSub(v);
5720          e->next=jjMakeSub(w);
5721  if (u->e==NULL)
5722    res->e=e;
5723  else
5724  {
5725    Subexpr h=u->e;
5726    while (h->next!=NULL) h=h->next;
5727    h->next=e;
5728    res->e=u->e;
5729    u->e=NULL;
5730  }
5731  return FALSE;
5732}
5733static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5734{
5735  sleftv t;
5736  sleftv ut;
5737  leftv p=NULL;
5738  intvec *iv=(intvec *)w->Data();
5739  int l;
5740  BOOLEAN nok;
5741
5742  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5743  {
5744    WerrorS("cannot build expression lists from unnamed objects");
5745    return TRUE;
5746  }
5747  memcpy(&ut,u,sizeof(ut));
5748  memset(&t,0,sizeof(t));
5749  t.rtyp=INT_CMD;
5750  for (l=0;l< iv->length(); l++)
5751  {
5752    t.data=(char *)(long)((*iv)[l]);
5753    if (p==NULL)
5754    {
5755      p=res;
5756    }
5757    else
5758    {
5759      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5760      p=p->next;
5761    }
5762    memcpy(u,&ut,sizeof(ut));
5763    if (u->Typ() == MATRIX_CMD)
5764      nok=jjBRACK_Ma(p,u,v,&t);
5765    else if (u->Typ() == BIGINTMAT_CMD)
5766      nok=jjBRACK_Bim(p,u,v,&t);
5767    else /* INTMAT_CMD */
5768      nok=jjBRACK_Im(p,u,v,&t);
5769    if (nok)
5770    {
5771      while (res->next!=NULL)
5772      {
5773        p=res->next->next;
5774        omFreeBin((ADDRESS)res->next, sleftv_bin);
5775        // res->e aufraeumen !!!!
5776        res->next=p;
5777      }
5778      return TRUE;
5779    }
5780  }
5781  return FALSE;
5782}
5783static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5784{
5785  sleftv t;
5786  sleftv ut;
5787  leftv p=NULL;
5788  intvec *iv=(intvec *)v->Data();
5789  int l;
5790  BOOLEAN nok;
5791
5792  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5793  {
5794    WerrorS("cannot build expression lists from unnamed objects");
5795    return TRUE;
5796  }
5797  memcpy(&ut,u,sizeof(ut));
5798  memset(&t,0,sizeof(t));
5799  t.rtyp=INT_CMD;
5800  for (l=0;l< iv->length(); l++)
5801  {
5802    t.data=(char *)(long)((*iv)[l]);
5803    if (p==NULL)
5804    {
5805      p=res;
5806    }
5807    else
5808    {
5809      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5810      p=p->next;
5811    }
5812    memcpy(u,&ut,sizeof(ut));
5813    if (u->Typ() == MATRIX_CMD)
5814      nok=jjBRACK_Ma(p,u,&t,w);
5815    else if (u->Typ() == BIGINTMAT_CMD)
5816      nok=jjBRACK_Bim(p,u,&t,w);
5817    else /* INTMAT_CMD */
5818      nok=jjBRACK_Im(p,u,&t,w);
5819    if (nok)
5820    {
5821      while (res->next!=NULL)
5822      {
5823        p=res->next->next;
5824        omFreeBin((ADDRESS)res->next, sleftv_bin);
5825        // res->e aufraeumen !!
5826        res->next=p;
5827      }
5828      return TRUE;
5829    }
5830  }
5831  return FALSE;
5832}
5833static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5834{
5835  sleftv t1,t2,ut;
5836  leftv p=NULL;
5837  intvec *vv=(intvec *)v->Data();
5838  intvec *wv=(intvec *)w->Data();
5839  int vl;
5840  int wl;
5841  BOOLEAN nok;
5842
5843  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5844  {
5845    WerrorS("cannot build expression lists from unnamed objects");
5846    return TRUE;
5847  }
5848  memcpy(&ut,u,sizeof(ut));
5849  memset(&t1,0,sizeof(sleftv));
5850  memset(&t2,0,sizeof(sleftv));
5851  t1.rtyp=INT_CMD;
5852  t2.rtyp=INT_CMD;
5853  for (vl=0;vl< vv->length(); vl++)
5854  {
5855    t1.data=(char *)(long)((*vv)[vl]);
5856    for (wl=0;wl< wv->length(); wl++)
5857    {
5858      t2.data=(char *)(long)((*wv)[wl]);
5859      if (p==NULL)
5860      {
5861        p=res;
5862      }
5863      else
5864      {
5865        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5866        p=p->next;
5867      }
5868      memcpy(u,&ut,sizeof(ut));
5869      if (u->Typ() == MATRIX_CMD)
5870        nok=jjBRACK_Ma(p,u,&t1,&t2);
5871      else if (u->Typ() == BIGINTMAT_CMD)
5872        nok=jjBRACK_Bim(p,u,&t1,&t2);
5873      else /* INTMAT_CMD */
5874        nok=jjBRACK_Im(p,u,&t1,&t2);
5875      if (nok)
5876      {
5877        res->CleanUp();
5878        return TRUE;
5879      }
5880    }
5881  }
5882  return FALSE;
5883}
5884static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5885{
5886  v->next=(leftv)omAllocBin(sleftv_bin);
5887  memcpy(v->next,w,sizeof(sleftv));
5888  memset(w,0,sizeof(sleftv));
5889  return jjPROC(res,u,v);
5890}
5891static BOOLEAN jjRING_2(leftv res, leftv u, leftv v, leftv w)
5892{
5893  u->next=(leftv)omAlloc(sizeof(sleftv));
5894  memcpy(u->next,v,sizeof(sleftv));
5895  memset(v,0,sizeof(sleftv));
5896  u->next->next=(leftv)omAlloc(sizeof(sleftv));
5897  memcpy(u->next->next,w,sizeof(sleftv));
5898  memset(w,0,sizeof(sleftv));
5899  BOOLEAN bo=iiExprArithM(res,u,'[');
5900  u->next=NULL;
5901  return bo;
5902}
5903static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5904{
5905  intvec *iv;
5906  ideal m;
5907  lists l=(lists)omAllocBin(slists_bin);
5908  int k=(int)(long)w->Data();
5909  if (k>=0)
5910  {
5911    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5912    l->Init(2);
5913    l->m[0].rtyp=MODUL_CMD;
5914    l->m[1].rtyp=INTVEC_CMD;
5915    l->m[0].data=(void *)m;
5916    l->m[1].data=(void *)iv;
5917  }
5918  else
5919  {
5920    m=sm_CallSolv((ideal)u->Data(), currRing);
5921    l->Init(1);
5922    l->m[0].rtyp=IDEAL_CMD;
5923    l->m[0].data=(void *)m;
5924  }
5925  res->data = (char *)l;
5926  return FALSE;
5927}
5928static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5929{
5930  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5931  {
5932    WerrorS("3rd argument must be a name of a matrix");
5933    return TRUE;
5934  }
5935  ideal i=(ideal)u->Data();
5936  int rank=(int)i->rank;
5937  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5938  if (r) return TRUE;
5939  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5940  return FALSE;
5941}
5942static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5943{
5944  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5945           (ideal)(v->Data()),(poly)(w->Data()));
5946  return FALSE;
5947}
5948static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5949{
5950  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5951  {
5952    WerrorS("3rd argument must be a name of a matrix");
5953    return TRUE;
5954  }
5955  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5956  poly p=(poly)u->CopyD(POLY_CMD);
5957  ideal i=idInit(1,1);
5958  i->m[0]=p;
5959  sleftv t;
5960  memset(&t,0,sizeof(t));
5961  t.data=(char *)i;
5962  t.rtyp=IDEAL_CMD;
5963  int rank=1;
5964  if (u->Typ()==VECTOR_CMD)
5965  {
5966    i->rank=rank=pMaxComp(p);
5967    t.rtyp=MODUL_CMD;
5968  }
5969  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5970  t.CleanUp();
5971  if (r) return TRUE;
5972  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5973  return FALSE;
5974}
5975static BOOLEAN jjELIMIN_ALG(leftv res, leftv u, leftv v, leftv w)
5976{
5977  ideal I=(ideal)u->Data();
5978  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
5979  res->data=(char *)idElimination(I,(poly)v->Data(),NULL,alg);
5980  //setFlag(res,FLAG_STD);
5981  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
5982}
5983static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5984{
5985  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5986    (intvec *)w->Data());
5987  //setFlag(res,FLAG_STD);
5988  return FALSE;
5989}
5990static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5991{
5992  /*4
5993  * look for the substring what in the string where
5994  * starting at position n
5995  * return the position of the first char of what in where
5996  * or 0
5997  */
5998  int n=(int)(long)w->Data();
5999  char *where=(char *)u->Data();
6000  char *what=(char *)v->Data();
6001  char *found;
6002  if ((1>n)||(n>(int)strlen(where)))
6003  {
6004    Werror("start position %d out of range",n);
6005    return TRUE;
6006  }
6007  found = strchr(where+n-1,*what);
6008  if (*(what+1)!='\0')
6009  {
6010    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
6011    {
6012      found=strchr(found+1,*what);
6013    }
6014  }
6015  if (found != NULL)
6016  {
6017    res->data=(char *)((found-where)+1);
6018  }
6019  return FALSE;
6020}
6021static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
6022{
6023  if ((int)(long)w->Data()==0)
6024    res->data=(char *)walkProc(u,v);
6025  else
6026    res->data=(char *)fractalWalkProc(u,v);
6027  setFlag( res, FLAG_STD );
6028  return FALSE;
6029}
6030static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
6031{
6032  intvec *wdegree=(intvec*)w->Data();
6033  if (wdegree->length()!=currRing->N)
6034  {
6035    Werror("weight vector must have size %d, not %d",
6036           currRing->N,wdegree->length());
6037    return TRUE;
6038  }
6039#ifdef HAVE_RINGS
6040  if (rField_is_Z(currRing))
6041  {
6042    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
6043    PrintS("//       performed for generic fibre, that is, over Q\n");
6044  }
6045#endif
6046  assumeStdFlag(u);
6047  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6048  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
6049  if (errorreported) return TRUE;
6050
6051  switch((int)(long)v->Data())
6052  {
6053    case 1:
6054      res->data=(void *)iv;
6055      return FALSE;
6056    case 2:
6057      res->data=(void *)hSecondSeries(iv);
6058      delete iv;
6059      return FALSE;
6060  }
6061  delete iv;
6062  WerrorS(feNotImplemented);
6063  return TRUE;
6064}
6065static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
6066{
6067  PrintS("TODO\n");
6068  int i=pVar((poly)v->Data());
6069  if (i==0)
6070  {
6071    WerrorS("ringvar expected");
6072    return TRUE;
6073  }
6074  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6075  int d=pWTotaldegree(p);
6076  pLmDelete(p);
6077  if (d==1)
6078    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
6079  else
6080    WerrorS("variable must have weight 1");
6081  return (d!=1);
6082}
6083static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
6084{
6085  PrintS("TODO\n");
6086  int i=pVar((poly)v->Data());
6087  if (i==0)
6088  {
6089    WerrorS("ringvar expected");
6090    return TRUE;
6091  }
6092  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6093  int d=pWTotaldegree(p);
6094  pLmDelete(p);
6095  if (d==1)
6096    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
6097  else
6098    WerrorS("variable must have weight 1");
6099  return (d!=1);
6100}
6101static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
6102{
6103  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
6104  intvec* arg = (intvec*) u->Data();
6105  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
6106
6107  for (i=0; i<n; i++)
6108  {
6109    (*im)[i] = (*arg)[i];
6110  }
6111
6112  res->data = (char *)im;
6113  return FALSE;
6114}
6115static BOOLEAN jjINTERSECT3(leftv res, leftv u, leftv v, leftv w)
6116{
6117  ideal I1=(ideal)u->Data();
6118  ideal I2=(ideal)v->Data();
6119  ideal I3=(ideal)w->Data();
6120  resolvente r=(resolvente)omAlloc0(3*sizeof(ideal));
6121  r[0]=I1;
6122  r[1]=I2;
6123  r[2]=I3;
6124  res->data=(char *)idMultSect(r,3);
6125  omFreeSize((ADDRESS)r,3*sizeof(ideal));
6126  return FALSE;
6127}
6128static BOOLEAN jjINTERSEC3S(leftv res, leftv u, leftv v, leftv w)
6129{
6130  ideal I=(ideal)u->Data();
6131  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6132  res->data=(char *)idSect(I,(ideal)v->Data(),alg);
6133  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6134  return FALSE;
6135}
6136static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
6137{
6138  short *iw=iv2array((intvec *)w->Data(),currRing);
6139  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
6140  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
6141  return FALSE;
6142}
6143static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
6144{
6145  if (!pIsUnit((poly)v->Data()))
6146  {
6147    WerrorS("2nd argument must be a unit");
6148    return TRUE;
6149  }
6150  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
6151  return FALSE;
6152}
6153static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
6154{
6155  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
6156                             (intvec *)w->Data(),currRing);
6157  return FALSE;
6158}
6159static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6160{
6161  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6162  {
6163    WerrorS("2nd argument must be a diagonal matrix of units");
6164    return TRUE;
6165  }
6166  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6167                               (matrix)v->CopyD());
6168  return FALSE;
6169}
6170static BOOLEAN jjMINOR_M(leftv res, leftv v)
6171{
6172  /* Here's the use pattern for the minor command:
6173        minor ( matrix_expression m, int_expression minorSize,
6174                optional ideal_expression IasSB, optional int_expression k,
6175                optional string_expression algorithm,
6176                optional int_expression cachedMinors,
6177                optional int_expression cachedMonomials )
6178     This method here assumes that there are at least two arguments.
6179     - If IasSB is present, it must be a std basis. All minors will be
6180       reduced w.r.t. IasSB.
6181     - If k is absent, all non-zero minors will be computed.
6182       If k is present and k > 0, the first k non-zero minors will be
6183       computed.
6184       If k is present and k < 0, the first |k| minors (some of which
6185       may be zero) will be computed.
6186       If k is present and k = 0, an error is reported.
6187     - If algorithm is absent, all the following arguments must be absent too.
6188       In this case, a heuristic picks the best-suited algorithm (among
6189       Bareiss, Laplace, and Laplace with caching).
6190       If algorithm is present, it must be one of "Bareiss", "bareiss",
6191       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6192       "cache" two more arguments may be given, determining how many entries
6193       the cache may have at most, and how many cached monomials there are at
6194       most. (Cached monomials are counted over all cached polynomials.)
6195       If these two additional arguments are not provided, 200 and 100000
6196       will be used as defaults.
6197  */
6198  matrix m;
6199  leftv u=v->next;
6200  v->next=NULL;
6201  int v_typ=v->Typ();
6202  if (v_typ==MATRIX_CMD)
6203  {
6204     m = (const matrix)v->Data();
6205  }
6206  else
6207  {
6208    if (v_typ==0)
6209    {
6210      Werror("`%s` is undefined",v->Fullname());
6211      return TRUE;
6212    }
6213    // try to convert to MATRIX:
6214    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6215    BOOLEAN bo;
6216    sleftv tmp;
6217    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6218    else bo=TRUE;
6219    if (bo)
6220    {
6221      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6222      return TRUE;
6223    }
6224    m=(matrix)tmp.data;
6225  }
6226  const int mk = (const int)(long)u->Data();
6227  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6228  bool noCacheMinors = true; bool noCacheMonomials = true;
6229  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6230
6231  /* here come the different cases of correct argument sets */
6232  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6233  {
6234    IasSB = (ideal)u->next->Data();
6235    noIdeal = false;
6236    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6237    {
6238      k = (int)(long)u->next->next->Data();
6239      noK = false;
6240      if ((u->next->next->next != NULL) &&
6241          (u->next->next->next->Typ() == STRING_CMD))
6242      {
6243        algorithm = (char*)u->next->next->next->Data();
6244        noAlgorithm = false;
6245        if ((u->next->next->next->next != NULL) &&
6246            (u->next->next->next->next->Typ() == INT_CMD))
6247        {
6248          cacheMinors = (int)(long)u->next->next->next->next->Data();
6249          noCacheMinors = false;
6250          if ((u->next->next->next->next->next != NULL) &&
6251              (u->next->next->next->next->next->Typ() == INT_CMD))
6252          {
6253            cacheMonomials =
6254               (int)(long)u->next->next->next->next->next->Data();
6255            noCacheMonomials = false;
6256          }
6257        }
6258      }
6259    }
6260  }
6261  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6262  {
6263    k = (int)(long)u->next->Data();
6264    noK = false;
6265    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6266    {
6267      algorithm = (char*)u->next->next->Data();
6268      noAlgorithm = false;
6269      if ((u->next->next->next != NULL) &&
6270          (u->next->next->next->Typ() == INT_CMD))
6271      {
6272        cacheMinors = (int)(long)u->next->next->next->Data();
6273        noCacheMinors = false;
6274        if ((u->next->next->next->next != NULL) &&
6275            (u->next->next->next->next->Typ() == INT_CMD))
6276        {
6277          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6278          noCacheMonomials = false;
6279        }
6280      }
6281    }
6282  }
6283  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6284  {
6285    algorithm = (char*)u->next->Data();
6286    noAlgorithm = false;
6287    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6288    {
6289      cacheMinors = (int)(long)u->next->next->Data();
6290      noCacheMinors = false;
6291      if ((u->next->next->next != NULL) &&
6292          (u->next->next->next->Typ() == INT_CMD))
6293      {
6294        cacheMonomials = (int)(long)u->next->next->next->Data();
6295        noCacheMonomials = false;
6296      }
6297    }
6298  }
6299
6300  /* upper case conversion for the algorithm if present */
6301  if (!noAlgorithm)
6302  {
6303    if (strcmp(algorithm, "bareiss") == 0)
6304      algorithm = (char*)"Bareiss";
6305    if (strcmp(algorithm, "laplace") == 0)
6306      algorithm = (char*)"Laplace";
6307    if (strcmp(algorithm, "cache") == 0)
6308      algorithm = (char*)"Cache";
6309  }
6310
6311  v->next=u;
6312  /* here come some tests */
6313  if (!noIdeal)
6314  {
6315    assumeStdFlag(u->next);
6316  }
6317  if ((!noK) && (k == 0))
6318  {
6319    WerrorS("Provided number of minors to be computed is zero.");
6320    return TRUE;
6321  }
6322  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6323      && (strcmp(algorithm, "Laplace") != 0)
6324      && (strcmp(algorithm, "Cache") != 0))
6325  {
6326    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6327    return TRUE;
6328  }
6329  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6330      && (!rField_is_Domain(currRing)))
6331  {
6332    Werror("Bareiss algorithm not defined over coefficient rings %s",
6333           "with zero divisors.");
6334    return TRUE;
6335  }
6336  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6337  {
6338    ideal I=idInit(1,1);
6339    if (mk<1) I->m[0]=p_One(currRing);
6340    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6341    //       m->rows(), m->cols());
6342    res->data=(void*)I;
6343    return FALSE;
6344  }
6345  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6346      && (noCacheMinors || noCacheMonomials))
6347  {
6348    cacheMinors = 200;
6349    cacheMonomials = 100000;
6350  }
6351
6352  /* here come the actual procedure calls */
6353  if (noAlgorithm)
6354    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6355                                       (noIdeal ? 0 : IasSB), false);
6356  else if (strcmp(algorithm, "Cache") == 0)
6357    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6358                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6359                                   cacheMonomials, false);
6360  else
6361    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6362                              (noIdeal ? 0 : IasSB), false);
6363  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6364  return FALSE;
6365}
6366static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6367{
6368  // u: the name of the new type
6369  // v: the parent type
6370  // w: the elements
6371  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6372                                            (const char *)w->Data());
6373  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6374  return (d==NULL);
6375}
6376static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6377{
6378  // handles preimage(r,phi,i) and kernel(r,phi)
6379  idhdl h;
6380  ring rr;
6381  map mapping;
6382  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6383
6384  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6385  {
6386    WerrorS("2nd/3rd arguments must have names");
6387    return TRUE;
6388  }
6389  rr=(ring)u->Data();
6390  const char *ring_name=u->Name();
6391  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6392  {
6393    if (h->typ==MAP_CMD)
6394    {
6395      mapping=IDMAP(h);
6396      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6397      if ((preim_ring==NULL)
6398      || (IDRING(preim_ring)!=currRing))
6399      {
6400        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6401        return TRUE;
6402      }
6403    }
6404    else if (h->typ==IDEAL_CMD)
6405    {
6406      mapping=IDMAP(h);
6407    }
6408    else
6409    {
6410      Werror("`%s` is no map nor ideal",IDID(h));
6411      return TRUE;
6412    }
6413  }
6414  else
6415  {
6416    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6417    return TRUE;
6418  }
6419  ideal image;
6420  if (kernel_cmd) image=idInit(1,1);
6421  else
6422  {
6423    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6424    {
6425      if (h->typ==IDEAL_CMD)
6426      {
6427        image=IDIDEAL(h);
6428      }
6429      else
6430      {
6431        Werror("`%s` is no ideal",IDID(h));
6432        return TRUE;
6433      }
6434    }
6435    else
6436    {
6437      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6438      return TRUE;
6439    }
6440  }
6441  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering(currRing)))
6442  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6443  {
6444    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6445  }
6446  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6447  if (kernel_cmd) idDelete(&image);
6448  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6449}
6450static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6451{
6452  int di, k;
6453  int i=(int)(long)u->Data();
6454  int r=(int)(long)v->Data();
6455  int c=(int)(long)w->Data();
6456  if ((r<=0) || (c<=0)) return TRUE;
6457  intvec *iv = new intvec(r, c, 0);
6458  if (iv->rows()==0)
6459  {
6460    delete iv;
6461    return TRUE;
6462  }
6463  if (i!=0)
6464  {
6465    if (i<0) i = -i;
6466    di = 2 * i + 1;
6467    for (k=0; k<iv->length(); k++)
6468    {
6469      (*iv)[k] = ((siRand() % di) - i);
6470    }
6471  }
6472  res->data = (char *)iv;
6473  return FALSE;
6474}
6475#ifdef SINGULAR_4_2
6476static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6477// <coeff>, par1, par2 -> number2
6478{
6479  coeffs cf=(coeffs)u->Data();
6480  if ((cf==NULL) ||(cf->cfRandom==NULL))
6481  {
6482    Werror("no random function defined for coeff %d",cf->type);
6483    return TRUE;
6484  }
6485  else
6486  {
6487    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6488    number2 nn=(number2)omAlloc(sizeof(*nn));
6489    nn->cf=cf;
6490    nn->n=n;
6491    res->data=nn;
6492    return FALSE;
6493  }
6494  return TRUE;
6495}
6496#endif
6497static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6498  int &ringvar, poly &monomexpr)
6499{
6500  monomexpr=(poly)w->Data();
6501  poly p=(poly)v->Data();
6502#if 0
6503  if (pLength(monomexpr)>1)
6504  {
6505    Werror("`%s` substitutes a ringvar only by a term",
6506      Tok2Cmdname(SUBST_CMD));
6507    return TRUE;
6508  }
6509#endif
6510  if ((ringvar=pVar(p))==0)
6511  {
6512    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6513    {
6514      number n = pGetCoeff(p);
6515      ringvar= -n_IsParam(n, currRing);
6516    }
6517    if(ringvar==0)
6518    {
6519      WerrorS("ringvar/par expected");
6520      return TRUE;
6521    }
6522  }
6523  return FALSE;
6524}
6525static BOOLEAN jjSUBST_Bu(leftv res, leftv u, leftv v,leftv w)
6526{
6527  // generic conversion from polyBucket to poly:
6528  // force this to be the first try everytime
6529  poly p; int l;
6530  sBucket_pt bu=(sBucket_pt)w->CopyD();
6531  sBucketDestroyAdd(bu,&p,&l);
6532  sleftv tmpw;
6533  tmpw.Init();
6534  tmpw.rtyp=POLY_CMD;
6535  tmpw.data=p;
6536  return iiExprArith3(res, iiOp, u, v, &tmpw);
6537}
6538static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6539{
6540  int ringvar;
6541  poly monomexpr;
6542  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6543  if (nok) return TRUE;
6544  poly p=(poly)u->Data();
6545  if (ringvar>0)
6546  {
6547    int mm=p_MaxExpPerVar(p,ringvar,currRing);
6548    if ((monomexpr!=NULL) && (p!=NULL) && (mm!=0) &&
6549    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)mm/2)))
6550    {
6551      Warn("possible OVERFLOW in subst, max exponent is %ld, substituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), mm);
6552      //return TRUE;
6553    }
6554    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6555      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6556    else
6557      res->data= pSubstPoly(p,ringvar,monomexpr);
6558  }
6559  else
6560  {
6561#ifdef HAVE_SHIFTBBA
6562    if (rIsLPRing(currRing))
6563    {
6564      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6565      return TRUE;
6566    }
6567#endif
6568    res->data=pSubstPar(p,-ringvar,monomexpr);
6569  }
6570  return FALSE;
6571}
6572static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6573{
6574  int ringvar;
6575  poly monomexpr;
6576  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6577  if (nok) return TRUE;
6578  ideal id=(ideal)u->Data();
6579  if (ringvar>0)
6580  {
6581    BOOLEAN overflow=FALSE;
6582    if (monomexpr!=NULL)
6583    {
6584      long deg_monexp=pTotaldegree(monomexpr);
6585      for(int i=IDELEMS(id)-1;i>=0;i--)
6586      {
6587        poly p=id->m[i];
6588        int mm=p_MaxExpPerVar(p,ringvar,currRing);
6589        if ((p!=NULL) && (mm!=0) &&
6590        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)mm/2)))
6591        {
6592          overflow=TRUE;
6593          break;
6594        }
6595      }
6596    }
6597    if (overflow)
6598      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6599    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6600    {
6601      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6602      else                       id=id_Copy(id,currRing);
6603      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6604    }
6605    else
6606      res->data = idSubstPoly(id,ringvar,monomexpr);
6607  }
6608  else
6609  {
6610#ifdef HAVE_SHIFTBBA
6611    if (rIsLPRing(currRing))
6612    {
6613      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6614      return TRUE;
6615    }
6616#endif
6617    res->data = idSubstPar(id,-ringvar,monomexpr);
6618  }
6619  return FALSE;
6620}
6621// we do not want to have jjSUBST_Id_X inlined:
6622static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6623                            int input_type);
6624static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6625{
6626  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6627}
6628static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6629{
6630  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6631}
6632static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6633{
6634  sleftv tmp;
6635  memset(&tmp,0,sizeof(tmp));
6636  // do not check the result, conversion from int/number to poly works always
6637  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6638  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6639  tmp.CleanUp();
6640  return b;
6641}
6642static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6643{
6644  int mi=(int)(long)v->Data();
6645  int ni=(int)(long)w->Data();
6646  if ((mi<1)||(ni<1))
6647  {
6648    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6649    return TRUE;
6650  }
6651  matrix m=mpNew(mi,ni);
6652  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6653  int i=si_min(IDELEMS(I),mi*ni);
6654  //for(i=i-1;i>=0;i--)
6655  //{
6656  //  m->m[i]=I->m[i];
6657  //  I->m[i]=NULL;
6658  //}
6659  memcpy(m->m,I->m,i*sizeof(poly));
6660  memset(I->m,0,i*sizeof(poly));
6661  id_Delete(&I,currRing);
6662  res->data = (char *)m;
6663  return FALSE;
6664}
6665static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6666{
6667  int mi=(int)(long)v->Data();
6668  int ni=(int)(long)w->Data();
6669  if ((mi<0)||(ni<1))
6670  {
6671    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6672    return TRUE;
6673  }
6674  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6675           mi,ni,currRing);
6676  return FALSE;
6677}
6678static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6679{
6680  int mi=(int)(long)v->Data();
6681  int ni=(int)(long)w->Data();
6682  if ((mi<1)||(ni<1))
6683  {
6684     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6685    return TRUE;
6686  }
6687  matrix m=mpNew(mi,ni);
6688  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6689  int r=si_min(MATROWS(I),mi);
6690  int c=si_min(MATCOLS(I),ni);
6691  int i,j;
6692  for(i=r;i>0;i--)
6693  {
6694    for(j=c;j>0;j--)
6695    {
6696      MATELEM(m,i,j)=MATELEM(I,i,j);
6697      MATELEM(I,i,j)=NULL;
6698    }
6699  }
6700  id_Delete((ideal *)&I,currRing);
6701  res->data = (char *)m;
6702  return FALSE;
6703}
6704static BOOLEAN jjSMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6705{
6706  int mi=(int)(long)v->Data();
6707  int ni=(int)(long)w->Data();
6708  if ((mi<0)||(ni<1))
6709  {
6710    Werror("converting to smatrix: dimensions must be positive(%dx%d)",mi,ni);
6711    return TRUE;
6712  }
6713  res->data = (char *)id_ResizeModule((ideal)u->CopyD(),
6714           mi,ni,currRing);
6715  return FALSE;
6716}
6717static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6718{
6719  if (w->rtyp!=IDHDL) return TRUE;
6720  int ul= IDELEMS((ideal)u->Data());
6721  int vl= IDELEMS((ideal)v->Data());
6722#ifdef HAVE_SHIFTBBA
6723  if (rIsLPRing(currRing))
6724  {
6725    if (currRing->LPncGenCount < ul)
6726    {
6727      Werror("At least %d ncgen variables are needed for this computation.", ul);
6728      return TRUE;
6729    }
6730  }
6731#endif
6732  ideal m
6733    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6734             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6735  if (m==NULL) return TRUE;
6736  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6737  return FALSE;
6738}
6739static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6740{
6741  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6742  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6743  idhdl hv=(idhdl)v->data;
6744  idhdl hw=(idhdl)w->data;
6745#ifdef HAVE_SHIFTBBA
6746  if (rIsLPRing(currRing))
6747  {
6748    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
6749    {
6750      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
6751      return TRUE;
6752    }
6753  }
6754#endif
6755  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6756  res->data = (char *)idLiftStd((ideal)u->Data(),
6757                                &(hv->data.umatrix),testHomog,
6758                                &(hw->data.uideal));
6759  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6760  return FALSE;
6761}
6762static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6763{
6764  assumeStdFlag(v);
6765  if (!idIsZeroDim((ideal)v->Data()))
6766  {
6767    Werror("`%s` must be 0-dimensional",v->Name());
6768    return TRUE;
6769  }
6770  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6771    (poly)w->CopyD());
6772  return FALSE;
6773}
6774static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6775{
6776  assumeStdFlag(v);
6777  if (!idIsZeroDim((ideal)v->Data()))
6778  {
6779    Werror("`%s` must be 0-dimensional",v->Name());
6780    return TRUE;
6781  }
6782  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6783    (matrix)w->CopyD());
6784  return FALSE;
6785}
6786static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6787{
6788  assumeStdFlag(v);
6789  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6790    0,(int)(long)w->Data());
6791  return FALSE;
6792}
6793static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6794{
6795  assumeStdFlag(v);
6796  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6797    0,(int)(long)w->Data());
6798  return FALSE;
6799}
6800#ifdef OLD_RES
6801static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6802{
6803  int maxl=(int)v->Data();
6804  ideal u_id=(ideal)u->Data();
6805  int l=0;
6806  resolvente r;
6807  intvec **weights=NULL;
6808  int wmaxl=maxl;
6809  maxl--;
6810  if ((maxl==-1) && (iiOp!=MRES_CMD))
6811    maxl = currRing->N-1;
6812  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6813  {
6814    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6815    if (iv!=NULL)
6816    {
6817      l=1;
6818      if (!idTestHomModule(u_id,currRing->qideal,iv))
6819      {
6820        WarnS("wrong weights");
6821        iv=NULL;
6822      }
6823      else
6824      {
6825        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6826        weights[0] = ivCopy(iv);
6827      }
6828    }
6829    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6830  }
6831  else
6832    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6833  if (r==NULL) return TRUE;
6834  int t3=u->Typ();
6835  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
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        if ((3*nCount) < sArithBase.nCmdUsed) {
7911                nCount++;
7912        }
7913        bb_list = getBlackboxTypes();
7914        // count the  number of entries;
7915        for (i=0; i<nCount; i++) {
7916                l++;
7917                if (i + 1 + nCount < sArithBase.nCmdUsed) {
7918                        l++;
7919                }
7920                if(i+1+2*nCount<sArithBase.nCmdUsed) {
7921                        l++;
7922                }
7923        }
7924        for (i = 0; i < bb_list->count; i++) {
7925                if (bb_list->list[i] != NULL) {
7926                        l++;
7927                }
7928        }
7929        // initiate list
7930        L->Init(l);
7931        k = 0;
7932        for (i=0; i<nCount; i++) {
7933                L->m[k].rtyp = STRING_CMD;
7934                L->m[k].data = omStrDup(sArithBase.sCmds[i+1].name);
7935                k++;
7936                // Print("%-20s", sArithBase.sCmds[i+1].name);
7937                if (i + 1 + nCount < sArithBase.nCmdUsed) {
7938                        L->m[k].rtyp = STRING_CMD;
7939                        L->m[k].data = omStrDup(sArithBase.sCmds[i+1+nCount].name);
7940                        k++;
7941                        // Print("%-20s", sArithBase.sCmds[i+1 + nCount].name);
7942                }
7943                if(i+1+2*nCount<sArithBase.nCmdUsed) {
7944                        L->m[k].rtyp = STRING_CMD;
7945                        L->m[k].data = omStrDup(sArithBase.sCmds[i+1+2*nCount].name);
7946                        k++;
7947                        // Print("%-20s", sArithBase.sCmds[i+1+2*nCount].name);
7948                }
7949                // PrintLn();
7950        }
7951
7952        // assign blackbox types
7953        for (i = 0; i < bb_list->count; i++) {
7954                if (bb_list->list[i] != NULL) {
7955                        L->m[k].rtyp = STRING_CMD;
7956                        // already used strdup in getBlackBoxTypes
7957                        L->m[k].data = bb_list->list[i];
7958                        k++;
7959                }
7960        }
7961        // free the struct (not the list itself)
7962        omfree(bb_list);
7963
7964        // pass the resultant list to the res datastructure
7965        res->data=(void *)L;
7966
7967        return FALSE;
7968}
7969static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7970{
7971  if (v == NULL)
7972  {
7973    res->data = omStrDup("");
7974    return FALSE;
7975  }
7976  int n = v->listLength();
7977  if (n == 1)
7978  {
7979    res->data = v->String();
7980    return FALSE;
7981  }
7982
7983  char** slist = (char**) omAlloc(n*sizeof(char*));
7984  int i, j;
7985
7986  for (i=0, j=0; i<n; i++, v = v ->next)
7987  {
7988    slist[i] = v->String();
7989    assume(slist[i] != NULL);
7990    j+=strlen(slist[i]);
7991  }
7992  char* s = (char*) omAlloc((j+1)*sizeof(char));
7993  *s='\0';
7994  for (i=0;i<n;i++)
7995  {
7996    strcat(s, slist[i]);
7997    omFree(slist[i]);
7998  }
7999  omFreeSize(slist, n*sizeof(char*));
8000  res->data = s;
8001  return FALSE;
8002}
8003static BOOLEAN jjTEST(leftv, leftv v)
8004{
8005  do
8006  {
8007    if (v->Typ()!=INT_CMD)
8008      return TRUE;
8009    test_cmd((int)(long)v->Data());
8010    v=v->next;
8011  }
8012  while (v!=NULL);
8013  return FALSE;
8014}
8015
8016#if defined(__alpha) && !defined(linux)
8017extern "C"
8018{
8019  void usleep(unsigned long usec);
8020};
8021#endif
8022static BOOLEAN jjFactModD_M(leftv res, leftv v)
8023{
8024  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
8025     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
8026
8027     valid argument lists:
8028     - (poly h, int d),
8029     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
8030     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
8031                                                          in list of ring vars,
8032     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
8033                                                optional: all 4 optional args
8034     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
8035      by singclap_factorize and h(0, y)
8036      has exactly two distinct monic factors [possibly with exponent > 1].)
8037     result:
8038     - list with the two factors f and g such that
8039       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
8040
8041  poly h      = NULL;
8042  int  d      =    1;
8043  poly f0     = NULL;
8044  poly g0     = NULL;
8045  int  xIndex =    1;   /* default index if none provided */
8046  int  yIndex =    2;   /* default index if none provided */
8047
8048  leftv u = v; int factorsGiven = 0;
8049  if ((u == NULL) || (u->Typ() != POLY_CMD))
8050  {
8051    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8052    return TRUE;
8053  }
8054  else h = (poly)u->Data();
8055  u = u->next;
8056  if ((u == NULL) || (u->Typ() != INT_CMD))
8057  {
8058    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8059    return TRUE;
8060  }
8061  else d = (int)(long)u->Data();
8062  u = u->next;
8063  if ((u != NULL) && (u->Typ() == POLY_CMD))
8064  {
8065    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
8066    {
8067      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8068      return TRUE;
8069    }
8070    else
8071    {
8072      f0 = (poly)u->Data();
8073      g0 = (poly)u->next->Data();
8074      factorsGiven = 1;
8075      u = u->next->next;
8076    }
8077  }
8078  if ((u != NULL) && (u->Typ() == INT_CMD))
8079  {
8080    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
8081    {
8082      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8083      return TRUE;
8084    }
8085    else
8086    {
8087      xIndex = (int)(long)u->Data();
8088      yIndex = (int)(long)u->next->Data();
8089      u = u->next->next;
8090    }
8091  }
8092  if (u != NULL)
8093  {
8094    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8095    return TRUE;
8096  }
8097
8098  /* checks for provided arguments */
8099  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
8100  {
8101    WerrorS("expected non-constant polynomial argument(s)");
8102    return TRUE;
8103  }
8104  int n = rVar(currRing);
8105  if ((xIndex < 1) || (n < xIndex))
8106  {
8107    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
8108    return TRUE;
8109  }
8110  if ((yIndex < 1) || (n < yIndex))
8111  {
8112    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
8113    return TRUE;
8114  }
8115  if (xIndex == yIndex)
8116  {
8117    WerrorS("expected distinct indices for variables x and y");
8118    return TRUE;
8119  }
8120
8121  /* computation of f0 and g0 if missing */
8122  if (factorsGiven == 0)
8123  {
8124    poly h0 = pSubst(pCopy(h), xIndex, NULL);
8125    intvec* v = NULL;
8126    ideal i = singclap_factorize(h0, &v, 0,currRing);
8127
8128    ivTest(v);
8129
8130    if (i == NULL) return TRUE;
8131
8132    idTest(i);
8133
8134    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
8135    {
8136      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
8137      return TRUE;
8138    }
8139    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
8140    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
8141    idDelete(&i);
8142  }
8143
8144  poly f; poly g;
8145  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
8146  lists L = (lists)omAllocBin(slists_bin);
8147  L->Init(2);
8148  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
8149  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
8150  res->rtyp = LIST_CMD;
8151  res->data = (char*)L;
8152  return FALSE;
8153}
8154static BOOLEAN jjSTATUS_M(leftv res, leftv v)
8155{
8156  if ((v->Typ() != LINK_CMD) ||
8157      (v->next->Typ() != STRING_CMD) ||
8158      (v->next->next->Typ() != STRING_CMD) ||
8159      (v->next->next->next->Typ() != INT_CMD))
8160    return TRUE;
8161  jjSTATUS3(res, v, v->next, v->next->next);
8162#if defined(HAVE_USLEEP)
8163  if (((long) res->data) == 0L)
8164  {
8165    int i_s = (int)(long) v->next->next->next->Data();
8166    if (i_s > 0)
8167    {
8168      usleep((int)(long) v->next->next->next->Data());
8169      jjSTATUS3(res, v, v->next, v->next->next);
8170    }
8171  }
8172#elif defined(HAVE_SLEEP)
8173  if (((int) res->data) == 0)
8174  {
8175    int i_s = (int) v->next->next->next->Data();
8176    if (i_s > 0)
8177    {
8178      si_sleep((is - 1)/1000000 + 1);
8179      jjSTATUS3(res, v, v->next, v->next->next);
8180    }
8181  }
8182#endif
8183  return FALSE;
8184}
8185static BOOLEAN jjSUBST_M(leftv res, leftv u)
8186{
8187  leftv v = u->next; // number of args > 0
8188  if (v==NULL) return TRUE;
8189  leftv w = v->next;
8190  if (w==NULL) return TRUE;
8191  leftv rest = w->next;
8192
8193  u->next = NULL;
8194  v->next = NULL;
8195  w->next = NULL;
8196  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
8197  if ((rest!=NULL) && (!b))
8198  {
8199    sleftv tmp_res;
8200    leftv tmp_next=res->next;
8201    res->next=rest;
8202    memset(&tmp_res,0,sizeof(tmp_res));
8203    b = iiExprArithM(&tmp_res,res,iiOp);
8204    memcpy(res,&tmp_res,sizeof(tmp_res));
8205    res->next=tmp_next;
8206  }
8207  u->next = v;
8208  v->next = w;
8209  // rest was w->next, but is already cleaned
8210  return b;
8211}
8212static BOOLEAN jjQRDS(leftv res, leftv INPUT)
8213{
8214  if ((INPUT->Typ() != MATRIX_CMD) ||
8215      (INPUT->next->Typ() != NUMBER_CMD) ||
8216      (INPUT->next->next->Typ() != NUMBER_CMD) ||
8217      (INPUT->next->next->next->Typ() != NUMBER_CMD))
8218  {
8219    WerrorS("expected (matrix, number, number, number) as arguments");
8220    return TRUE;
8221  }
8222  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
8223  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
8224                                    (number)(v->Data()),
8225                                    (number)(w->Data()),
8226                                    (number)(x->Data()));
8227  return FALSE;
8228}
8229static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
8230{ ideal result;
8231  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
8232  leftv v = u->next;  /* one additional polynomial or ideal */
8233  leftv h = v->next;  /* Hilbert vector */
8234  leftv w = h->next;  /* weight vector */
8235  assumeStdFlag(u);
8236  ideal i1=(ideal)(u->Data());
8237  ideal i0;
8238  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
8239  || (h->Typ()!=INTVEC_CMD)
8240  || (w->Typ()!=INTVEC_CMD))
8241  {
8242    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8243    return TRUE;
8244  }
8245  intvec *vw=(intvec *)w->Data(); // weights of vars
8246  /* merging std_hilb_w and std_1 */
8247  if (vw->length()!=currRing->N)
8248  {
8249    Werror("%d weights for %d variables",vw->length(),currRing->N);
8250    return TRUE;
8251  }
8252  int r=v->Typ();
8253  BOOLEAN cleanup_i0=FALSE;
8254  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
8255  {
8256    i0=idInit(1,i1->rank);
8257    i0->m[0]=(poly)v->Data();
8258    cleanup_i0=TRUE;
8259  }
8260  else if (r==IDEAL_CMD)/* IDEAL */
8261  {
8262    i0=(ideal)v->Data();
8263  }
8264  else
8265  {
8266    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8267    return TRUE;
8268  }
8269  int ii0=idElem(i0);
8270  i1 = idSimpleAdd(i1,i0);
8271  if (cleanup_i0)
8272  {
8273    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
8274    idDelete(&i0);
8275  }
8276  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8277  tHomog hom=testHomog;
8278  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
8279  if (ww!=NULL)
8280  {
8281    if (!idTestHomModule(i1,currRing->qideal,ww))
8282    {
8283      WarnS("wrong weights");
8284      ww=NULL;
8285    }
8286    else
8287    {
8288      ww=ivCopy(ww);
8289      hom=isHomog;
8290    }
8291  }
8292  BITSET save1;
8293  SI_SAVE_OPT1(save1);
8294  si_opt_1|=Sy_bit(OPT_SB_1);
8295  result=kStd(i1,
8296              currRing->qideal,
8297              hom,
8298              &ww,                  // module weights
8299              (intvec *)h->Data(),  // hilbert series
8300              0,                    // syzComp, whatever it is...
8301              IDELEMS(i1)-ii0,      // new ideal
8302              vw);                  // weights of vars
8303  SI_RESTORE_OPT1(save1);
8304  idDelete(&i1);
8305  idSkipZeroes(result);
8306  res->data = (char *)result;
8307  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
8308  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
8309  return FALSE;
8310}
8311
8312static BOOLEAN jjRING_PL(leftv res, leftv a)
8313{
8314  //Print("construct ring\n");
8315  if (a->Typ()!=CRING_CMD)
8316  {
8317    WerrorS("expected `cring` [ `id` ... ]");
8318    return TRUE;
8319  }
8320  assume(a->next!=NULL);
8321  leftv names=a->next;
8322  int N=names->listLength();
8323  char **n=(char**)omAlloc0(N*sizeof(char*));
8324  for(int i=0; i<N;i++,names=names->next)
8325  {
8326    n[i]=(char *)names->Name();
8327  }
8328  coeffs cf=(coeffs)a->CopyD();
8329  res->data=rDefault(cf,N,n, ringorder_dp);
8330  omFreeSize(n,N*sizeof(char*));
8331  return FALSE;
8332}
8333
8334static Subexpr jjMakeSub(leftv e)
8335{
8336  assume( e->Typ()==INT_CMD );
8337  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
8338  r->start =(int)(long)e->Data();
8339  return r;
8340}
8341static BOOLEAN jjRESTART(leftv, leftv u)
8342{
8343  int c=(int)(long)u->Data();
8344  switch(c)
8345  {
8346    case 0:{
8347        PrintS("delete all variables\n");
8348        killlocals(0);
8349        WerrorS("restarting...");
8350        break;
8351      };
8352    default: WerrorS("not implemented");
8353  }
8354  return FALSE;
8355}
8356#define D(A)    (A)
8357#define NULL_VAL NULL
8358#define IPARITH
8359#include "table.h"
8360
8361#include "iparith.inc"
8362
8363/*=================== operations with 2 args. ============================*/
8364/* must be ordered: first operations for chars (infix ops),
8365 * then alphabetically */
8366
8367static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
8368                                    BOOLEAN proccall,
8369                                    const struct sValCmd2* dA2,
8370                                    int at, int bt,
8371                                    const struct sConvertTypes *dConvertTypes)
8372{
8373  memset(res,0,sizeof(sleftv));
8374  BOOLEAN call_failed=FALSE;
8375
8376  if (!errorreported)
8377  {
8378    int i=0;
8379    iiOp=op;
8380    while (dA2[i].cmd==op)
8381    {
8382      if ((at==dA2[i].arg1)
8383      && (bt==dA2[i].arg2))
8384      {
8385        res->rtyp=dA2[i].res;
8386        if (currRing!=NULL)
8387        {
8388          if (check_valid(dA2[i].valid_for,op)) break;
8389        }
8390        else
8391        {
8392          if (RingDependend(dA2[i].res))
8393          {
8394            WerrorS("no ring active (3)");
8395            break;
8396          }
8397        }
8398        if (traceit&TRACE_CALL)
8399          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
8400        if ((call_failed=dA2[i].p(res,a,b)))
8401        {
8402          break;// leave loop, goto error handling
8403        }
8404        a->CleanUp();
8405        b->CleanUp();
8406        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8407        return FALSE;
8408      }
8409      i++;
8410    }
8411    // implicite type conversion ----------------------------------------------
8412    if (dA2[i].cmd!=op)
8413    {
8414      int ai,bi;
8415      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8416      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8417      BOOLEAN failed=FALSE;
8418      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8419      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8420      while (dA2[i].cmd==op)
8421      {
8422        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8423        if ((dA2[i].valid_for & NO_CONVERSION)==0)
8424        {
8425          if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8426          {
8427            if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8428            {
8429              res->rtyp=dA2[i].res;
8430              if (currRing!=NULL)
8431              {
8432                if (check_valid(dA2[i].valid_for,op)) break;
8433              }
8434              else
8435              {
8436                if (RingDependend(dA2[i].res))
8437                {
8438                  WerrorS("no ring active (4)");
8439                  break;
8440                }
8441              }
8442              if (traceit&TRACE_CALL)
8443                Print("call %s(%s,%s)\n",iiTwoOps(op),
8444                Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8445              failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8446              || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8447              || (call_failed=dA2[i].p(res,an,bn)));
8448              // everything done, clean up temp. variables
8449              if (failed)
8450              {
8451                // leave loop, goto error handling
8452                break;
8453              }
8454              else
8455              {
8456                // everything ok, clean up and return
8457                an->CleanUp();
8458                bn->CleanUp();
8459                omFreeBin((ADDRESS)an, sleftv_bin);
8460                omFreeBin((ADDRESS)bn, sleftv_bin);
8461                return FALSE;
8462              }
8463            }
8464          }
8465        }
8466        i++;
8467      }
8468      an->CleanUp();
8469      bn->CleanUp();
8470      omFreeBin((ADDRESS)an, sleftv_bin);
8471      omFreeBin((ADDRESS)bn, sleftv_bin);
8472    }
8473    // error handling ---------------------------------------------------
8474    const char *s=NULL;
8475    if (!errorreported)
8476    {
8477      if ((at==0) && (a->Fullname()!=sNoName_fe))
8478      {
8479        s=a->Fullname();
8480      }
8481      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8482      {
8483        s=b->Fullname();
8484      }
8485      if (s!=NULL)
8486        Werror("`%s` is not defined",s);
8487      else
8488      {
8489        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8490        s = iiTwoOps(op);
8491        if (proccall)
8492        {
8493          Werror("%s(`%s`,`%s`) failed"
8494                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8495        }
8496        else
8497        {
8498          Werror("`%s` %s `%s` failed"
8499                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8500        }
8501        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8502        {
8503          while (dA2[i].cmd==op)
8504          {
8505            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8506            && (dA2[i].res!=0)
8507            && (dA2[i].p!=jjWRONG2))
8508            {
8509              if (proccall)
8510                Werror("expected %s(`%s`,`%s`)"
8511                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8512              else
8513                Werror("expected `%s` %s `%s`"
8514                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8515            }
8516            i++;
8517          }
8518        }
8519      }
8520    }
8521    a->CleanUp();
8522    b->CleanUp();
8523    res->rtyp = UNKNOWN;
8524  }
8525  return TRUE;
8526}
8527BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8528                                    const struct sValCmd2* dA2,
8529                                    int at,
8530                                    const struct sConvertTypes *dConvertTypes)
8531{
8532  leftv b=a->next;
8533  a->next=NULL;
8534  int bt=b->Typ();
8535  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8536  a->next=b;
8537  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8538  return bo;
8539}
8540BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8541{
8542  memset(res,0,sizeof(sleftv));
8543
8544  if (!errorreported)
8545  {
8546#ifdef SIQ
8547    if (siq>0)
8548    {
8549      //Print("siq:%d\n",siq);
8550      command d=(command)omAlloc0Bin(sip_command_bin);
8551      memcpy(&d->arg1,a,sizeof(sleftv));
8552      a->Init();
8553      memcpy(&d->arg2,b,sizeof(sleftv));
8554      b->Init();
8555      d->argc=2;
8556      d->op=op;
8557      res->data=(char *)d;
8558      res->rtyp=COMMAND;
8559      return FALSE;
8560    }
8561#endif
8562    int at=a->Typ();
8563    int bt=b->Typ();
8564    // handling bb-objects ----------------------------------------------------
8565    if (at>MAX_TOK)
8566    {
8567      blackbox *bb=getBlackboxStuff(at);
8568      if (bb!=NULL)
8569      {
8570        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8571        //else: no op defined, try the default
8572      }
8573      else
8574      return TRUE;
8575    }
8576    else if ((bt>MAX_TOK)&&(op!='('))
8577    {
8578      blackbox *bb=getBlackboxStuff(bt);
8579      if (bb!=NULL)
8580      {
8581        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8582        // else: no op defined
8583      }
8584      else
8585      return TRUE;
8586    }
8587    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8588    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8589  }
8590  a->CleanUp();
8591  b->CleanUp();
8592  return TRUE;
8593}
8594
8595/*==================== operations with 1 arg. ===============================*/
8596/* must be ordered: first operations for chars (infix ops),
8597 * then alphabetically */
8598
8599BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, const struct sValCmd1* dA1, int at, const struct sConvertTypes *dConvertTypes)
8600{
8601  memset(res,0,sizeof(sleftv));
8602  BOOLEAN call_failed=FALSE;
8603
8604  if (!errorreported)
8605  {
8606    BOOLEAN failed=FALSE;
8607    iiOp=op;
8608    int i = 0;
8609    while (dA1[i].cmd==op)
8610    {
8611      if (at==dA1[i].arg)
8612      {
8613        if (currRing!=NULL)
8614        {
8615          if (check_valid(dA1[i].valid_for,op)) break;
8616        }
8617        else
8618        {
8619          if (RingDependend(dA1[i].res))
8620          {
8621            WerrorS("no ring active (5)");
8622            break;
8623          }
8624        }
8625        if (traceit&TRACE_CALL)
8626          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8627        res->rtyp=dA1[i].res;
8628        if ((call_failed=dA1[i].p(res,a)))
8629        {
8630          break;// leave loop, goto error handling
8631        }
8632        if (a->Next()!=NULL)
8633        {
8634          res->next=(leftv)omAllocBin(sleftv_bin);
8635          failed=iiExprArith1(res->next,a->next,op);
8636        }
8637        a->CleanUp();
8638        return failed;
8639      }
8640      i++;
8641    }
8642    // implicite type conversion --------------------------------------------
8643    if (dA1[i].cmd!=op)
8644    {
8645      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8646      i=0;
8647      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8648      while (dA1[i].cmd==op)
8649      {
8650        int ai;
8651        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8652        if ((dA1[i].valid_for & NO_CONVERSION)==0)
8653        {
8654          if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8655          {
8656            if (currRing!=NULL)
8657            {
8658              if (check_valid(dA1[i].valid_for,op)) break;
8659            }
8660            else
8661            {
8662              if (RingDependend(dA1[i].res))
8663              {
8664                WerrorS("no ring active (6)");
8665                break;
8666              }
8667            }
8668            if (traceit&TRACE_CALL)
8669              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8670            res->rtyp=dA1[i].res;
8671            failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8672            || (call_failed=dA1[i].p(res,an)));
8673            // everything done, clean up temp. variables
8674            if (failed)
8675            {
8676              // leave loop, goto error handling
8677              break;
8678            }
8679            else
8680            {
8681              if (an->Next() != NULL)
8682              {
8683                res->next = (leftv)omAllocBin(sleftv_bin);
8684                failed=iiExprArith1(res->next,an->next,op);
8685              }
8686              // everything ok, clean up and return
8687              an->CleanUp();
8688              omFreeBin((ADDRESS)an, sleftv_bin);
8689              return failed;
8690            }
8691          }
8692        }
8693        i++;
8694      }
8695      an->CleanUp();
8696      omFreeBin((ADDRESS)an, sleftv_bin);
8697    }
8698    // error handling
8699    if (!errorreported)
8700    {
8701      if ((at==0) && (a->Fullname()!=sNoName_fe))
8702      {
8703        Werror("`%s` is not defined",a->Fullname());
8704      }
8705      else
8706      {
8707        i=0;
8708        const char *s = iiTwoOps(op);
8709        Werror("%s(`%s`) failed"
8710                ,s,Tok2Cmdname(at));
8711        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8712        {
8713          while (dA1[i].cmd==op)
8714          {
8715            if ((dA1[i].res!=0)
8716            && (dA1[i].p!=jjWRONG))
8717              Werror("expected %s(`%s`)"
8718                ,s,Tok2Cmdname(dA1[i].arg));
8719            i++;
8720          }
8721        }
8722      }
8723    }
8724    res->rtyp = UNKNOWN;
8725  }
8726  a->CleanUp();
8727  return TRUE;
8728}
8729BOOLEAN iiExprArith1(leftv res, leftv a, int op)
8730{
8731  memset(res,0,sizeof(sleftv));
8732
8733  if (!errorreported)
8734  {
8735#ifdef SIQ
8736    if (siq>0)
8737    {
8738      //Print("siq:%d\n",siq);
8739      command d=(command)omAlloc0Bin(sip_command_bin);
8740      memcpy(&d->arg1,a,sizeof(sleftv));
8741      a->Init();
8742      d->op=op;
8743      d->argc=1;
8744      res->data=(char *)d;
8745      res->rtyp=COMMAND;
8746      return FALSE;
8747    }
8748#endif
8749    int at=a->Typ();
8750    // handling bb-objects ----------------------------------------------------
8751    if(op>MAX_TOK) // explicit type conversion to bb
8752    {
8753      blackbox *bb=getBlackboxStuff(op);
8754      if (bb!=NULL)
8755      {
8756        res->rtyp=op;
8757        res->data=bb->blackbox_Init(bb);
8758        if(!bb->blackbox_Assign(res,a)) return FALSE;
8759      }
8760      else
8761      return TRUE;
8762    }
8763    else if (at>MAX_TOK) // argument is of bb-type
8764    {
8765      blackbox *bb=getBlackboxStuff(at);
8766      if (bb!=NULL)
8767      {
8768        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
8769        // else: no op defined
8770      }
8771      else
8772      return TRUE;
8773    }
8774    if (errorreported) return TRUE;
8775
8776    iiOp=op;
8777    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8778    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
8779  }
8780  a->CleanUp();
8781  return TRUE;
8782}
8783
8784/*=================== operations with 3 args. ============================*/
8785/* must be ordered: first operations for chars (infix ops),
8786 * then alphabetically */
8787
8788static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
8789  const struct sValCmd3* dA3, int at, int bt, int ct,
8790  const struct sConvertTypes *dConvertTypes)
8791{
8792  memset(res,0,sizeof(sleftv));
8793  BOOLEAN call_failed=FALSE;
8794
8795  assume(dA3[0].cmd==op);
8796
8797  if (!errorreported)
8798  {
8799    int i=0;
8800    iiOp=op;
8801    while (dA3[i].cmd==op)
8802    {
8803      if ((at==dA3[i].arg1)
8804      && (bt==dA3[i].arg2)
8805      && (ct==dA3[i].arg3))
8806      {
8807        res->rtyp=dA3[i].res;
8808        if (currRing!=NULL)
8809        {
8810          if (check_valid(dA3[i].valid_for,op)) break;
8811        }
8812        if (traceit&TRACE_CALL)
8813          Print("call %s(%s,%s,%s)\n",
8814            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8815        if ((call_failed=dA3[i].p(res,a,b,c)))
8816        {
8817          break;// leave loop, goto error handling
8818        }
8819        a->CleanUp();
8820        b->CleanUp();
8821        c->CleanUp();
8822        return FALSE;
8823      }
8824      i++;
8825    }
8826    // implicite type conversion ----------------------------------------------
8827    if (dA3[i].cmd!=op)
8828    {
8829      int ai,bi,ci;
8830      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8831      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8832      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8833      BOOLEAN failed=FALSE;
8834      i=0;
8835      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8836      while (dA3[i].cmd==op)
8837      {
8838        if ((dA3[i].valid_for & NO_CONVERSION)==0)
8839        {
8840          if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
8841          {
8842            if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
8843            {
8844              if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
8845              {
8846                res->rtyp=dA3[i].res;
8847                if (currRing!=NULL)
8848                {
8849                  if (check_valid(dA3[i].valid_for,op)) break;
8850                }
8851                if (traceit&TRACE_CALL)
8852                  Print("call %s(%s,%s,%s)\n",
8853                    iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
8854                    Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
8855                failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
8856                  || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
8857                  || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
8858                  || (call_failed=dA3[i].p(res,an,bn,cn)));
8859                // everything done, clean up temp. variables
8860                if (failed)
8861                {
8862                  // leave loop, goto error handling
8863                  break;
8864                }
8865                else
8866                {
8867                  // everything ok, clean up and return
8868                  an->CleanUp();
8869                  bn->CleanUp();
8870                  cn->CleanUp();
8871                  omFreeBin((ADDRESS)an, sleftv_bin);
8872                  omFreeBin((ADDRESS)bn, sleftv_bin);
8873                  omFreeBin((ADDRESS)cn, sleftv_bin);
8874                  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8875                  return FALSE;
8876                }
8877              }
8878            }
8879          }
8880        }
8881        i++;
8882      }
8883      an->CleanUp();
8884      bn->CleanUp();
8885      cn->CleanUp();
8886      omFreeBin((ADDRESS)an, sleftv_bin);
8887      omFreeBin((ADDRESS)bn, sleftv_bin);
8888      omFreeBin((ADDRESS)cn, sleftv_bin);
8889    }
8890    // error handling ---------------------------------------------------
8891    if (!errorreported)
8892    {
8893      const char *s=NULL;
8894      if ((at==0) && (a->Fullname()!=sNoName_fe))
8895      {
8896        s=a->Fullname();
8897      }
8898      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8899      {
8900        s=b->Fullname();
8901      }
8902      else if ((ct==0) && (c->Fullname()!=sNoName_fe))
8903      {
8904        s=c->Fullname();
8905      }
8906      if (s!=NULL)
8907        Werror("`%s` is not defined",s);
8908      else
8909      {
8910        i=0;
8911        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8912        const char *s = iiTwoOps(op);
8913        Werror("%s(`%s`,`%s`,`%s`) failed"
8914                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8915        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8916        {
8917          while (dA3[i].cmd==op)
8918          {
8919            if(((at==dA3[i].arg1)
8920            ||(bt==dA3[i].arg2)
8921            ||(ct==dA3[i].arg3))
8922            && (dA3[i].res!=0))
8923            {
8924              Werror("expected %s(`%s`,`%s`,`%s`)"
8925                  ,s,Tok2Cmdname(dA3[i].arg1)
8926                  ,Tok2Cmdname(dA3[i].arg2)
8927                  ,Tok2Cmdname(dA3[i].arg3));
8928            }
8929            i++;
8930          }
8931        }
8932      }
8933    }
8934    res->rtyp = UNKNOWN;
8935  }
8936  a->CleanUp();
8937  b->CleanUp();
8938  c->CleanUp();
8939  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8940  return TRUE;
8941}
8942BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8943{
8944  memset(res,0,sizeof(sleftv));
8945
8946  if (!errorreported)
8947  {
8948#ifdef SIQ
8949    if (siq>0)
8950    {
8951      //Print("siq:%d\n",siq);
8952      command d=(command)omAlloc0Bin(sip_command_bin);
8953      memcpy(&d->arg1,a,sizeof(sleftv));
8954      a->Init();
8955      memcpy(&d->arg2,b,sizeof(sleftv));
8956      b->Init();
8957      memcpy(&d->arg3,c,sizeof(sleftv));
8958      c->Init();
8959      d->op=op;
8960      d->argc=3;
8961      res->data=(char *)d;
8962      res->rtyp=COMMAND;
8963      return FALSE;
8964    }
8965#endif
8966    int at=a->Typ();
8967    // handling bb-objects ----------------------------------------------
8968    if (at>MAX_TOK)
8969    {
8970      blackbox *bb=getBlackboxStuff(at);
8971      if (bb!=NULL)
8972      {
8973        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8974        // else: no op defined
8975      }
8976      else
8977      return TRUE;
8978      if (errorreported) return TRUE;
8979    }
8980    int bt=b->Typ();
8981    int ct=c->Typ();
8982
8983    iiOp=op;
8984    int i=0;
8985    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8986    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8987  }
8988  a->CleanUp();
8989  b->CleanUp();
8990  c->CleanUp();
8991  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8992  return TRUE;
8993}
8994BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
8995                                    const struct sValCmd3* dA3,
8996                                    int at,
8997                                    const struct sConvertTypes *dConvertTypes)
8998{
8999  leftv b=a->next;
9000  a->next=NULL;
9001  int bt=b->Typ();
9002  leftv c=b->next;
9003  b->next=NULL;
9004  int ct=c->Typ();
9005  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9006  b->next=c;
9007  a->next=b;
9008  a->CleanUp(); // to cleanup the chain, content already done
9009  return bo;
9010}
9011/*==================== operations with many arg. ===============================*/
9012/* must be ordered: first operations for chars (infix ops),
9013 * then alphabetically */
9014
9015#if 0 // unused
9016static BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
9017{
9018  // cnt = 0: all
9019  // cnt = 1: only first one
9020  leftv next;
9021  BOOLEAN failed = TRUE;
9022  if(v==NULL) return failed;
9023  res->rtyp = LIST_CMD;
9024  if(cnt) v->next = NULL;
9025  next = v->next;             // saving next-pointer
9026  failed = jjLIST_PL(res, v);
9027  v->next = next;             // writeback next-pointer
9028  return failed;
9029}
9030#endif
9031
9032BOOLEAN iiExprArithM(leftv res, leftv a, int op)
9033{
9034  memset(res,0,sizeof(sleftv));
9035
9036  if (!errorreported)
9037  {
9038#ifdef SIQ
9039    if (siq>0)
9040    {
9041      //Print("siq:%d\n",siq);
9042      command d=(command)omAlloc0Bin(sip_command_bin);
9043      d->op=op;
9044      res->data=(char *)d;
9045      if (a!=NULL)
9046      {
9047        d->argc=a->listLength();
9048        // else : d->argc=0;
9049        memcpy(&d->arg1,a,sizeof(sleftv));
9050        switch(d->argc)
9051        {
9052          case 3:
9053            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
9054            a->next->next->Init();
9055            /* no break */
9056          case 2:
9057            memcpy(&d->arg2,a->next,sizeof(sleftv));
9058            a->next->Init();
9059            a->next->next=d->arg2.next;
9060            d->arg2.next=NULL;
9061            /* no break */
9062          case 1:
9063            a->Init();
9064            a->next=d->arg1.next;
9065            d->arg1.next=NULL;
9066        }
9067        if (d->argc>3) a->next=NULL;
9068        a->name=NULL;
9069        a->rtyp=0;
9070        a->data=NULL;
9071        a->e=NULL;
9072        a->attribute=NULL;
9073        a->CleanUp();
9074      }
9075      res->rtyp=COMMAND;
9076      return FALSE;
9077    }
9078#endif
9079    if ((a!=NULL) && (a->Typ()>MAX_TOK))
9080    {
9081      blackbox *bb=getBlackboxStuff(a->Typ());
9082      if (bb!=NULL)
9083      {
9084        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
9085        // else: no op defined
9086      }
9087      else
9088      return TRUE;
9089      if (errorreported) return TRUE;
9090    }
9091    int args=0;
9092    if (a!=NULL) args=a->listLength();
9093
9094    iiOp=op;
9095    int i=0;
9096    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
9097    while (dArithM[i].cmd==op)
9098    {
9099      if ((args==dArithM[i].number_of_args)
9100      || (dArithM[i].number_of_args==-1)
9101      || ((dArithM[i].number_of_args==-2)&&(args>0)))
9102      {
9103        res->rtyp=dArithM[i].res;
9104        if (currRing!=NULL)
9105        {
9106          if (check_valid(dArithM[i].valid_for,op)) break;
9107        }
9108        if (traceit&TRACE_CALL)
9109          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
9110        if (dArithM[i].p(res,a))
9111        {
9112          break;// leave loop, goto error handling
9113        }
9114        if (a!=NULL) a->CleanUp();
9115        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9116        return FALSE;
9117      }
9118      i++;
9119    }
9120    // error handling
9121    if (!errorreported)
9122    {
9123      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName_fe))
9124      {
9125        Werror("`%s` is not defined",a->Fullname());
9126      }
9127      else
9128      {
9129        const char *s = iiTwoOps(op);
9130        Werror("%s(...) failed",s);
9131      }
9132    }
9133    res->rtyp = UNKNOWN;
9134  }
9135  if (a!=NULL) a->CleanUp();
9136        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9137  return TRUE;
9138}
9139
9140/*=================== general utilities ============================*/
9141int IsCmd(const char *n, int & tok)
9142{
9143  int i;
9144  int an=1;
9145  int en=sArithBase.nLastIdentifier;
9146
9147  loop
9148  //for(an=0; an<sArithBase.nCmdUsed; )
9149  {
9150    if(an>=en-1)
9151    {
9152      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9153      {
9154        i=an;
9155        break;
9156      }
9157      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9158      {
9159        i=en;
9160        break;
9161      }
9162      else
9163      {
9164        // -- blackbox extensions:
9165        // return 0;
9166        return blackboxIsCmd(n,tok);
9167      }
9168    }
9169    i=(an+en)/2;
9170    if (*n < *(sArithBase.sCmds[i].name))
9171    {
9172      en=i-1;
9173    }
9174    else if (*n > *(sArithBase.sCmds[i].name))
9175    {
9176      an=i+1;
9177    }
9178    else
9179    {
9180      int v=strcmp(n,sArithBase.sCmds[i].name);
9181      if(v<0)
9182      {
9183        en=i-1;
9184      }
9185      else if(v>0)
9186      {
9187        an=i+1;
9188      }
9189      else /*v==0*/
9190      {
9191        break;
9192      }
9193    }
9194  }
9195  lastreserved=sArithBase.sCmds[i].name;
9196  tok=sArithBase.sCmds[i].tokval;
9197  if(sArithBase.sCmds[i].alias==2)
9198  {
9199    Warn("outdated identifier `%s` used - please change your code",
9200    sArithBase.sCmds[i].name);
9201    sArithBase.sCmds[i].alias=1;
9202  }
9203  #if 0
9204  if (currRingHdl==NULL)
9205  {
9206    #ifdef SIQ
9207    if (siq<=0)
9208    {
9209    #endif
9210      if ((tok>=BEGIN_RING) && (tok<=END_RING))
9211      {
9212        WerrorS("no ring active");
9213        return 0;
9214      }
9215    #ifdef SIQ
9216    }
9217    #endif
9218  }
9219  #endif
9220  if (!expected_parms)
9221  {
9222    switch (tok)
9223    {
9224      case IDEAL_CMD:
9225      case INT_CMD:
9226      case INTVEC_CMD:
9227      case MAP_CMD:
9228      case MATRIX_CMD:
9229      case MODUL_CMD:
9230      case POLY_CMD:
9231      case PROC_CMD:
9232      case RING_CMD:
9233      case STRING_CMD:
9234        cmdtok = tok;
9235        break;
9236    }
9237  }
9238  return sArithBase.sCmds[i].toktype;
9239}
9240static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
9241{
9242  // user defined types are not in the pre-computed table:
9243  if (op>MAX_TOK) return 0;
9244
9245  int a=0;
9246  int e=len;
9247  int p=len/2;
9248  do
9249  {
9250     if (op==dArithTab[p].cmd) return dArithTab[p].start;
9251     if (op<dArithTab[p].cmd) e=p-1;
9252     else   a = p+1;
9253     p=a+(e-a)/2;
9254  }
9255  while ( a <= e);
9256
9257  // catch missing a cmd:
9258  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
9259  // Print("op %d (%c) unknown",op,op);
9260  return 0;
9261}
9262
9263typedef char si_char_2[2];
9264STATIC_VAR si_char_2 Tok2Cmdname_buf=" ";
9265const char * Tok2Cmdname(int tok)
9266{
9267  if (tok <= 0)
9268  {
9269    return sArithBase.sCmds[0].name;
9270  }
9271  if (tok==ANY_TYPE) return "any_type";
9272  if (tok==COMMAND) return "command";
9273  if (tok==NONE) return "nothing";
9274  if (tok < 128)
9275  {
9276    Tok2Cmdname_buf[1]=(char)tok;
9277    return Tok2Cmdname_buf;
9278  }
9279  //if (tok==IFBREAK) return "if_break";
9280  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
9281  //if (tok==ORDER_VECTOR) return "ordering";
9282  //if (tok==REF_VAR) return "ref";
9283  //if (tok==OBJECT) return "object";
9284  //if (tok==PRINT_EXPR) return "print_expr";
9285  if (tok==IDHDL) return "identifier";
9286  if (tok>MAX_TOK) return getBlackboxName(tok);
9287  unsigned i;
9288  for(i=0; i<sArithBase.nCmdUsed; i++)
9289    //while (sArithBase.sCmds[i].tokval!=0)
9290  {
9291    if ((sArithBase.sCmds[i].tokval == tok)&&
9292        (sArithBase.sCmds[i].alias==0))
9293    {
9294      return sArithBase.sCmds[i].name;
9295    }
9296  }
9297  // try gain for alias/old names:
9298  for(i=0; i<sArithBase.nCmdUsed; i++)
9299  {
9300    if (sArithBase.sCmds[i].tokval == tok)
9301    {
9302      return sArithBase.sCmds[i].name;
9303    }
9304  }
9305  return sArithBase.sCmds[0].name;
9306}
9307
9308
9309/*---------------------------------------------------------------------*/
9310/**
9311 * @brief compares to entry of cmdsname-list
9312
9313 @param[in] a
9314 @param[in] b
9315
9316 @return <ReturnValue>
9317**/
9318/*---------------------------------------------------------------------*/
9319static int _gentable_sort_cmds( const void *a, const void *b )
9320{
9321  cmdnames *pCmdL = (cmdnames*)a;
9322  cmdnames *pCmdR = (cmdnames*)b;
9323
9324  if(a==NULL || b==NULL)             return 0;
9325
9326  /* empty entries goes to the end of the list for later reuse */
9327  if(pCmdL->name==NULL) return 1;
9328  if(pCmdR->name==NULL) return -1;
9329
9330  /* $INVALID$ must come first */
9331  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
9332  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
9333
9334  /* tokval=-1 are reserved names at the end */
9335  if (pCmdL->tokval==-1)
9336  {
9337    if (pCmdR->tokval==-1)
9338       return strcmp(pCmdL->name, pCmdR->name);
9339    /* pCmdL->tokval==-1, pCmdL goes at the end */
9340    return 1;
9341  }
9342  /* pCmdR->tokval==-1, pCmdR goes at the end */
9343  if(pCmdR->tokval==-1) return -1;
9344
9345  return strcmp(pCmdL->name, pCmdR->name);
9346}
9347
9348/*---------------------------------------------------------------------*/
9349/**
9350 * @brief initialisation of arithmetic structured data
9351
9352 @retval 0 on success
9353
9354**/
9355/*---------------------------------------------------------------------*/
9356int iiInitArithmetic()
9357{
9358  //printf("iiInitArithmetic()\n");
9359  memset(&sArithBase, 0, sizeof(sArithBase));
9360  iiInitCmdName();
9361  /* fix last-identifier */
9362#if 0
9363  /* we expect that gentable allready did every thing */
9364  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9365      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
9366    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9367  }
9368#endif
9369  //Print("L=%d\n", sArithBase.nLastIdentifier);
9370
9371  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
9372  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
9373
9374  //iiArithAddCmd("Top", 0,-1,0);
9375
9376
9377  //for(i=0; i<sArithBase.nCmdUsed; i++) {
9378  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
9379  //         sArithBase.sCmds[i].name,
9380  //         sArithBase.sCmds[i].alias,
9381  //         sArithBase.sCmds[i].tokval,
9382  //         sArithBase.sCmds[i].toktype);
9383  //}
9384  //iiArithRemoveCmd("Top");
9385  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
9386  //iiArithRemoveCmd("mygcd");
9387  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
9388  return 0;
9389}
9390
9391int iiArithFindCmd(const char *szName)
9392{
9393  int an=0;
9394  int i = 0,v = 0;
9395  int en=sArithBase.nLastIdentifier;
9396
9397  loop
9398  //for(an=0; an<sArithBase.nCmdUsed; )
9399  {
9400    if(an>=en-1)
9401    {
9402      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
9403      {
9404        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
9405        return an;
9406      }
9407      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
9408      {
9409        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
9410        return en;
9411      }
9412      else
9413      {
9414        //Print("RET- 1\n");
9415        return -1;
9416      }
9417    }
9418    i=(an+en)/2;
9419    if (*szName < *(sArithBase.sCmds[i].name))
9420    {
9421      en=i-1;
9422    }
9423    else if (*szName > *(sArithBase.sCmds[i].name))
9424    {
9425      an=i+1;
9426    }
9427    else
9428    {
9429      v=strcmp(szName,sArithBase.sCmds[i].name);
9430      if(v<0)
9431      {
9432        en=i-1;
9433      }
9434      else if(v>0)
9435      {
9436        an=i+1;
9437      }
9438      else /*v==0*/
9439      {
9440        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9441        return i;
9442      }
9443    }
9444  }
9445  //if(i>=0 && i<sArithBase.nCmdUsed)
9446  //  return i;
9447  //PrintS("RET-2\n");
9448  return -2;
9449}
9450
9451char *iiArithGetCmd( int nPos )
9452{
9453  if(nPos<0) return NULL;
9454  if(nPos<(int)sArithBase.nCmdUsed)
9455    return sArithBase.sCmds[nPos].name;
9456  return NULL;
9457}
9458
9459int iiArithRemoveCmd(const char *szName)
9460{
9461  int nIndex;
9462  if(szName==NULL) return -1;
9463
9464  nIndex = iiArithFindCmd(szName);
9465  if(nIndex<0 || nIndex>=(int)sArithBase.nCmdUsed)
9466  {
9467    Print("'%s' not found (%d)\n", szName, nIndex);
9468    return -1;
9469  }
9470  omFree(sArithBase.sCmds[nIndex].name);
9471  sArithBase.sCmds[nIndex].name=NULL;
9472  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9473        (&_gentable_sort_cmds));
9474  sArithBase.nCmdUsed--;
9475
9476  /* fix last-identifier */
9477  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9478      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9479  {
9480    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9481  }
9482  //Print("L=%d\n", sArithBase.nLastIdentifier);
9483  return 0;
9484}
9485
9486int iiArithAddCmd(
9487  const char *szName,
9488  short nAlias,
9489  short nTokval,
9490  short nToktype,
9491  short nPos
9492  )
9493{
9494  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9495  //       nTokval, nToktype, nPos);
9496  if(nPos>=0)
9497  {
9498    // no checks: we rely on a correct generated code in iparith.inc
9499    assume((unsigned)nPos < sArithBase.nCmdAllocated);
9500    assume(szName!=NULL);
9501    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9502    sArithBase.sCmds[nPos].alias   = nAlias;
9503    sArithBase.sCmds[nPos].tokval  = nTokval;
9504    sArithBase.sCmds[nPos].toktype = nToktype;
9505    sArithBase.nCmdUsed++;
9506    //if(nTokval>0) sArithBase.nLastIdentifier++;
9507  }
9508  else
9509  {
9510    if(szName==NULL) return -1;
9511    int nIndex = iiArithFindCmd(szName);
9512    if(nIndex>=0)
9513    {
9514      Print("'%s' already exists at %d\n", szName, nIndex);
9515      return -1;
9516    }
9517
9518    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9519    {
9520      /* needs to create new slots */
9521      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9522      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9523      if(sArithBase.sCmds==NULL) return -1;
9524      sArithBase.nCmdAllocated++;
9525    }
9526    /* still free slots available */
9527    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9528    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9529    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9530    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9531    sArithBase.nCmdUsed++;
9532
9533    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9534          (&_gentable_sort_cmds));
9535    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9536        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9537    {
9538      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9539    }
9540    //Print("L=%d\n", sArithBase.nLastIdentifier);
9541  }
9542  return 0;
9543}
9544
9545static BOOLEAN check_valid(const int p, const int op)
9546{
9547  #ifdef HAVE_PLURAL
9548  if (rIsPluralRing(currRing))
9549  {
9550    if ((p & NC_MASK)==NO_NC)
9551    {
9552      WerrorS("not implemented for non-commutative rings");
9553      return TRUE;
9554    }
9555    else if ((p & NC_MASK)==COMM_PLURAL)
9556    {
9557      Warn("assume commutative subalgebra for cmd `%s` in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9558      return FALSE;
9559    }
9560    /* else, ALLOW_PLURAL */
9561  }
9562  #ifdef HAVE_SHIFTBBA
9563  else if (rIsLPRing(currRing))
9564  {
9565    if ((p & ALLOW_LP)==0)
9566    {
9567      Werror("`%s` not implemented for letterplace rings in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9568      return TRUE;
9569    }
9570  }
9571  #endif
9572  #endif
9573#ifdef HAVE_RINGS
9574  if (rField_is_Ring(currRing))
9575  {
9576    if ((p & RING_MASK)==0 /*NO_RING*/)
9577    {
9578      WerrorS("not implemented for rings with rings as coeffients");
9579      return TRUE;
9580    }
9581    /* else ALLOW_RING */
9582    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9583    &&(!rField_is_Domain(currRing)))
9584    {
9585      WerrorS("domain required as coeffients");
9586      return TRUE;
9587    }
9588    /* else ALLOW_ZERODIVISOR */
9589    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9590    {
9591      WarnS("considering the image in Q[...]");
9592    }
9593  }
9594#endif
9595  return FALSE;
9596}
9597// --------------------------------------------------------------------
9598static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
9599{
9600  if ((currRing!=NULL)
9601  && rField_is_Ring(currRing)
9602  && (!rField_is_Z(currRing)))
9603  {
9604    WerrorS("not implemented for rings with rings as coeffients (except ZZ)");
9605    return TRUE;
9606  }
9607  coeffs cf;
9608  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
9609  int rl=c->nr+1;
9610  int return_type=c->m[0].Typ();
9611  if ((return_type!=IDEAL_CMD)
9612  && (return_type!=MODUL_CMD)
9613  && (return_type!=MATRIX_CMD)
9614  && (return_type!=POLY_CMD))
9615  {
9616    if((return_type==BIGINT_CMD)
9617    ||(return_type==INT_CMD))
9618      return_type=BIGINT_CMD;
9619    else if (return_type==LIST_CMD)
9620    {
9621      // create a tmp list of the correct size
9622      lists res_l=(lists)omAllocBin(slists_bin);
9623      res_l->Init(rl /*c->nr+1*/);
9624      BOOLEAN bo=FALSE;
9625      int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,CHINREM_CMD);
9626      for (unsigned i=0;i<=(unsigned)c->nr;i++)
9627      {
9628        sleftv tmp;
9629        tmp.Copy(v);
9630        bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],CHINREM_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9631        if (bo) { Werror("chinrem failed for list entry %d",i+1); break;}
9632      }
9633      c->Clean();
9634      res->data=res_l;
9635      res->rtyp=LIST_CMD;
9636      return bo;
9637    }
9638    else
9639    {
9640      c->Clean();
9641      WerrorS("poly/ideal/module/matrix/list expected");
9642      return TRUE;
9643    }
9644  }
9645  if (return_type==BIGINT_CMD)
9646    cf=coeffs_BIGINT;
9647  else
9648  {
9649    cf=currRing->cf;
9650    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
9651      cf=cf->extRing->cf;
9652  }
9653  lists pl=NULL;
9654  intvec *p=NULL;
9655  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
9656  else                    p=(intvec*)v->Data();
9657  ideal result;
9658  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
9659  number *xx=NULL;
9660  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
9661  int i;
9662  if (return_type!=BIGINT_CMD)
9663  {
9664    for(i=rl-1;i>=0;i--)
9665    {
9666      if (c->m[i].Typ()!=return_type)
9667      {
9668        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
9669        omFree(x); // delete c
9670        return TRUE;
9671      }
9672      if (return_type==POLY_CMD)
9673      {
9674        x[i]=idInit(1,1);
9675        x[i]->m[0]=(poly)c->m[i].CopyD();
9676      }
9677      else
9678      {
9679        x[i]=(ideal)c->m[i].CopyD();
9680      }
9681      //c->m[i].Init();
9682    }
9683  }
9684  else
9685  {
9686    if (nMap==NULL)
9687    {
9688      Werror("not implemented: map bigint -> %s", nCoeffName(cf));
9689      return TRUE;
9690    }
9691    xx=(number *)omAlloc(rl*sizeof(number));
9692    for(i=rl-1;i>=0;i--)
9693    {
9694      if (c->m[i].Typ()==INT_CMD)
9695      {
9696        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
9697      }
9698      else if (c->m[i].Typ()==BIGINT_CMD)
9699      {
9700        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
9701      }
9702      else
9703      {
9704        Werror("bigint expected at pos %d",i+1);
9705        omFree(x); // delete c
9706        omFree(xx); // delete c
9707        return TRUE;
9708      }
9709    }
9710  }
9711  number *q=(number *)omAlloc(rl*sizeof(number));
9712  if (p!=NULL)
9713  {
9714    for(i=rl-1;i>=0;i--)
9715    {
9716      q[i]=n_Init((*p)[i], cf);
9717    }
9718  }
9719  else
9720  {
9721    for(i=rl-1;i>=0;i--)
9722    {
9723      if (pl->m[i].Typ()==INT_CMD)
9724      {
9725        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
9726      }
9727      else if (pl->m[i].Typ()==BIGINT_CMD)
9728      {
9729        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
9730      }
9731      else
9732      {
9733        Werror("bigint expected at pos %d",i+1);
9734        for(i++;i<rl;i++)
9735        {
9736          n_Delete(&(q[i]),cf);
9737        }
9738        omFree(x); // delete c
9739        omFree(q); // delete pl
9740        if (xx!=NULL) omFree(xx); // delete c
9741        return TRUE;
9742      }
9743    }
9744  }
9745  if (return_type==BIGINT_CMD)
9746  {
9747    CFArray i_v(rl);
9748    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,i_v,coeffs_BIGINT);
9749    res->data=(char *)n;
9750  }
9751  else
9752  {
9753    result=id_ChineseRemainder(x,q,rl,currRing); // deletes also x
9754    c->Clean();
9755    if ((return_type==POLY_CMD) &&(result!=NULL))
9756    {
9757      res->data=(char *)result->m[0];
9758      result->m[0]=NULL;
9759      idDelete(&result);
9760    }
9761    else
9762      res->data=(char *)result;
9763  }
9764  for(i=rl-1;i>=0;i--)
9765  {
9766    n_Delete(&(q[i]),cf);
9767  }
9768  omFree(q);
9769  res->rtyp=return_type;
9770  return result==NULL;
9771}
9772static BOOLEAN jjFAREY_LI(leftv res, leftv u, leftv v)
9773{
9774  lists c=(lists)u->CopyD();
9775  lists res_l=(lists)omAllocBin(slists_bin);
9776  res_l->Init(c->nr+1);
9777  BOOLEAN bo=FALSE;
9778  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,FAREY_CMD);
9779  for (unsigned i=0;i<=(unsigned)c->nr;i++)
9780  {
9781    sleftv tmp;
9782    tmp.Copy(v);
9783    bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],FAREY_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9784    if (bo) { Werror("farey failed for list entry %d",i+1); break;}
9785  }
9786  c->Clean();
9787  res->data=res_l;
9788  return bo;
9789}
9790// --------------------------------------------------------------------
9791static int jjCOMPARE_ALL(const void * aa, const void * bb)
9792{
9793  leftv a=(leftv)aa;
9794  int at=a->Typ();
9795  leftv b=(leftv)bb;
9796  int bt=b->Typ();
9797  if (at < bt) return -1;
9798  if (at > bt) return 1;
9799  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,'<');
9800  sleftv tmp;
9801  memset(&tmp,0,sizeof(sleftv));
9802  iiOp='<';
9803  BOOLEAN bo=iiExprArith2TabIntern(&tmp,a,'<',b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
9804  if (bo)
9805  {
9806    Werror(" no `<` for %s",Tok2Cmdname(at));
9807    unsigned long ad=(unsigned long)a->Data();
9808    unsigned long bd=(unsigned long)b->Data();
9809    if (ad<bd) return -1;
9810    else if (ad==bd) return 0;
9811    else return 1;
9812  }
9813  else if (tmp.data==NULL) /* not < */
9814  {
9815    iiOp=EQUAL_EQUAL;
9816    tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,EQUAL_EQUAL);
9817    bo=iiExprArith2TabIntern(&tmp,a,EQUAL_EQUAL,b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
9818    if (bo)
9819    {
9820      Werror(" no `==` for %s",Tok2Cmdname(at));
9821      unsigned long ad=(unsigned long)a->Data();
9822      unsigned long bd=(unsigned long)b->Data();
9823      if (ad<bd) return -1;
9824      else if (ad==bd) return 0;
9825      else return 1;
9826    }
9827    else if (tmp.data==NULL) /* not <,== */ return 1;
9828    else return 0;
9829  }
9830  else return -1;
9831}
9832BOOLEAN jjSORTLIST(leftv, leftv arg)
9833{
9834  lists l=(lists)arg->Data();
9835  if (l->nr>0)
9836  {
9837    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
9838  }
9839  return FALSE;
9840}
9841BOOLEAN jjUNIQLIST(leftv, leftv arg)
9842{
9843  lists l=(lists)arg->Data();
9844  if (l->nr>0)
9845  {
9846    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
9847    int i, j, len;
9848    len=l->nr;
9849    i=0;
9850    while(i<len)
9851    {
9852      if(jjCOMPARE_ALL(&(l->m[i]),&(l->m[i+1]))==0)
9853      {
9854        l->m[i].CleanUp();
9855        for(j=i; j<len;j++) l->m[j]=l->m[j+1];
9856        memset(&(l->m[len]),0,sizeof(sleftv));
9857        l->m[len].rtyp=DEF_CMD;
9858        len--;
9859      }
9860      else
9861        i++;
9862    }
9863    //Print("new len:%d\n",len);
9864  }
9865  return FALSE;
9866}
Note: See TracBrowser for help on using the repository browser.