source: git/Singular/iparith.cc @ d25e3f

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