source: git/Singular/iparith.cc @ a97ac0

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