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