source: git/Singular/iparith.cc @ 78f8b7a

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