source: git/Singular/iparith.cc @ 6f4f9c

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