source: git/Singular/iparith.cc @ 469a11

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