source: git/Singular/iparith.cc @ 8cfc91

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