source: git/Singular/iparith.cc @ bef72d

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