source: git/Singular/iparith.cc @ cdc87c

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