source: git/Singular/iparith.cc @ a3f0fea

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