source: git/Singular/iparith.cc @ 95585d3

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