source: git/Singular/iparith.cc @ f8c970f

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