source: git/Singular/iparith.cc @ 7e4d60

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