source: git/Singular/iparith.cc @ 9ba310

fieker-DuValspielwiese
Last change on this file since 9ba310 was 9ba310, checked in by Hans Schoenemann <hannes@…>, 4 years ago
typo in comment
  • 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 correct 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  int isLetterplace=(int)(long)atGet(v,"isLetterplaceRing",INT_CMD);
4501  ring r=rCompose(l,TRUE,mm,isLetterplace);
4502  res->data=(char *)r;
4503  return (r==NULL);
4504}
4505static BOOLEAN jjPFAC1(leftv res, leftv v)
4506{
4507  /* call method jjPFAC2 with second argument = 0 (meaning that no
4508     valid bound for the prime factors has been given) */
4509  sleftv tmp;
4510  memset(&tmp, 0, sizeof(tmp));
4511  tmp.rtyp = INT_CMD;
4512  return jjPFAC2(res, v, &tmp);
4513}
4514static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4515{
4516  /* computes the LU-decomposition of a matrix M;
4517     i.e., M = P * L * U, where
4518        - P is a row permutation matrix,
4519        - L is in lower triangular form,
4520        - U is in upper row echelon form
4521     Then, we also have P * M = L * U.
4522     A list [P, L, U] is returned. */
4523  matrix mat = (const matrix)v->Data();
4524  if (!idIsConstant((ideal)mat))
4525  {
4526    WerrorS("matrix must be constant");
4527    return TRUE;
4528  }
4529  matrix pMat;
4530  matrix lMat;
4531  matrix uMat;
4532
4533  luDecomp(mat, pMat, lMat, uMat);
4534
4535  lists ll = (lists)omAllocBin(slists_bin);
4536  ll->Init(3);
4537  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4538  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4539  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4540  res->data=(char*)ll;
4541
4542  return FALSE;
4543}
4544static BOOLEAN jjMEMORY(leftv res, leftv v)
4545{
4546  // clean out "_":
4547  sLastPrinted.CleanUp();
4548  memset(&sLastPrinted,0,sizeof(sleftv));
4549  // collect all info:
4550  omUpdateInfo();
4551  switch(((int)(long)v->Data()))
4552  {
4553  case 0:
4554    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4555    break;
4556  case 1:
4557    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4558    break;
4559  case 2:
4560    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4561    break;
4562  default:
4563    omPrintStats(stdout);
4564    omPrintInfo(stdout);
4565    omPrintBinStats(stdout);
4566    res->data = (char *)0;
4567    res->rtyp = NONE;
4568  }
4569  return FALSE;
4570  res->data = (char *)0;
4571  return FALSE;
4572}
4573//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4574//{
4575//  return jjMONITOR2(res,v,NULL);
4576//}
4577static BOOLEAN jjMSTD(leftv res, leftv v)
4578{
4579  int t=v->Typ();
4580  ideal r,m;
4581  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4582  lists l=(lists)omAllocBin(slists_bin);
4583  l->Init(2);
4584  l->m[0].rtyp=t;
4585  l->m[0].data=(char *)r;
4586  setFlag(&(l->m[0]),FLAG_STD);
4587  l->m[1].rtyp=t;
4588  l->m[1].data=(char *)m;
4589  res->data=(char *)l;
4590  return FALSE;
4591}
4592static BOOLEAN jjMULT(leftv res, leftv v)
4593{
4594  assumeStdFlag(v);
4595  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4596  return FALSE;
4597}
4598static BOOLEAN jjMINRES_R(leftv res, leftv v)
4599{
4600  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4601
4602  syStrategy tmp=(syStrategy)v->Data();
4603  tmp = syMinimize(tmp); // enrich itself!
4604
4605  res->data=(char *)tmp;
4606
4607  if (weights!=NULL)
4608    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4609
4610  return FALSE;
4611}
4612static BOOLEAN jjN2BI(leftv res, leftv v)
4613{
4614  number n,i; i=(number)v->Data();
4615  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4616  if (nMap!=NULL)
4617    n=nMap(i,currRing->cf,coeffs_BIGINT);
4618  else goto err;
4619  res->data=(void *)n;
4620  return FALSE;
4621err:
4622  WerrorS("cannot convert to bigint"); return TRUE;
4623}
4624static BOOLEAN jjNAMEOF(leftv res, leftv v)
4625{
4626  if ((v->rtyp==IDHDL)||(v->rtyp==ALIAS_CMD))
4627    res->data=omStrDup(v->name);
4628  else if (v->name==NULL)
4629    res->data=omStrDup("");
4630  else
4631  {
4632    res->data = (char *)v->name;
4633    v->name=NULL;
4634  }
4635  return FALSE;
4636}
4637static BOOLEAN jjNAMES(leftv res, leftv v)
4638{
4639  res->data=ipNameList(((ring)v->Data())->idroot);
4640  return FALSE;
4641}
4642static BOOLEAN jjNAMES_I(leftv res, leftv v)
4643{
4644  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4645  return FALSE;
4646}
4647static BOOLEAN jjNOT(leftv res, leftv v)
4648{
4649  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4650  return FALSE;
4651}
4652static BOOLEAN jjNVARS(leftv res, leftv v)
4653{
4654  res->data = (char *)(long)(((ring)(v->Data()))->N);
4655  return FALSE;
4656}
4657static BOOLEAN jjOpenClose(leftv, leftv v)
4658{
4659  si_link l=(si_link)v->Data();
4660  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4661  else { slPrepClose(l); return slClose(l);}
4662}
4663static BOOLEAN jjORD(leftv res, leftv v)
4664{
4665  poly p=(poly)v->Data();
4666  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4667  return FALSE;
4668}
4669static BOOLEAN jjPAR1(leftv res, leftv v)
4670{
4671  int i=(int)(long)v->Data();
4672  int p=0;
4673  p=rPar(currRing);
4674  if ((0<i) && (i<=p))
4675  {
4676    res->data=(char *)n_Param(i,currRing);
4677  }
4678  else
4679  {
4680    Werror("par number %d out of range 1..%d",i,p);
4681    return TRUE;
4682  }
4683  return FALSE;
4684}
4685static BOOLEAN jjPARDEG(leftv res, leftv v)
4686{
4687  number nn=(number)v->Data();
4688  res->data = (char *)(long)n_ParDeg(nn, currRing->cf);
4689  return FALSE;
4690}
4691static BOOLEAN jjPARSTR1(leftv res, leftv v)
4692{
4693  if (currRing==NULL)
4694  {
4695    WerrorS("no ring active (1)");
4696    return TRUE;
4697  }
4698  int i=(int)(long)v->Data();
4699  int p=0;
4700  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4701    res->data=omStrDup(rParameter(currRing)[i-1]);
4702  else
4703  {
4704    Werror("par number %d out of range 1..%d",i,p);
4705    return TRUE;
4706  }
4707  return FALSE;
4708}
4709static BOOLEAN jjP2BI(leftv res, leftv v)
4710{
4711  poly p=(poly)v->Data();
4712  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4713  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4714  {
4715    WerrorS("poly must be constant");
4716    return TRUE;
4717  }
4718  number i=pGetCoeff(p);
4719  number n;
4720  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4721  if (nMap!=NULL)
4722    n=nMap(i,currRing->cf,coeffs_BIGINT);
4723  else goto err;
4724  res->data=(void *)n;
4725  return FALSE;
4726err:
4727  WerrorS("cannot convert to bigint"); return TRUE;
4728}
4729static BOOLEAN jjP2I(leftv res, leftv v)
4730{
4731  poly p=(poly)v->Data();
4732  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4733  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4734  {
4735    WerrorS("poly must be constant");
4736    return TRUE;
4737  }
4738  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4739  return FALSE;
4740}
4741static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4742{
4743  map mapping=(map)v->Data();
4744  syMake(res,omStrDup(mapping->preimage));
4745  return FALSE;
4746}
4747static BOOLEAN jjPRIME(leftv res, leftv v)
4748{
4749  int i = IsPrime((int)(long)(v->Data()));
4750  res->data = (char *)(long)(i > 1 ? i : 2);
4751  return FALSE;
4752}
4753static BOOLEAN jjPRUNE(leftv res, leftv v)
4754{
4755  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4756  ideal v_id=(ideal)v->Data();
4757  if (w!=NULL)
4758  {
4759    if (!idTestHomModule(v_id,currRing->qideal,w))
4760    {
4761      WarnS("wrong weights");
4762      w=NULL;
4763      // and continue at the non-homog case below
4764    }
4765    else
4766    {
4767      w=ivCopy(w);
4768      intvec **ww=&w;
4769      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4770      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4771      return FALSE;
4772    }
4773  }
4774  res->data = (char *)idMinEmbedding(v_id);
4775  return FALSE;
4776}
4777static BOOLEAN jjP2N(leftv res, leftv v)
4778{
4779  number n;
4780  poly p;
4781  if (((p=(poly)v->Data())!=NULL)
4782  && (pIsConstant(p)))
4783  {
4784    n=nCopy(pGetCoeff(p));
4785  }
4786  else
4787  {
4788    n=nInit(0);
4789  }
4790  res->data = (char *)n;
4791  return FALSE;
4792}
4793static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4794{
4795  char *s= (char *)v->Data();
4796  // try system keywords
4797  for(unsigned i=0; i<sArithBase.nCmdUsed; i++)
4798  {
4799    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4800    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4801    {
4802      res->data = (char *)1;
4803      return FALSE;
4804    }
4805  }
4806  // try blackbox names
4807  int id;
4808  blackboxIsCmd(s,id);
4809  if (id>0)
4810  {
4811    res->data = (char *)1;
4812  }
4813  return FALSE;
4814}
4815static BOOLEAN jjRANK1(leftv res, leftv v)
4816{
4817  matrix m =(matrix)v->Data();
4818  int rank = luRank(m, 0);
4819  res->data =(char *)(long)rank;
4820  return FALSE;
4821}
4822static BOOLEAN jjREAD(leftv res, leftv v)
4823{
4824  return jjREAD2(res,v,NULL);
4825}
4826static BOOLEAN jjREGULARITY(leftv res, leftv v)
4827{
4828  res->data = (char *)(long)iiRegularity((lists)v->Data());
4829  return FALSE;
4830}
4831static BOOLEAN jjREPART(leftv res, leftv v)
4832{
4833  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4834  return FALSE;
4835}
4836static BOOLEAN jjRINGLIST(leftv res, leftv v)
4837{
4838  ring r=(ring)v->Data();
4839  if (r!=NULL)
4840  {
4841    res->data = (char *)rDecompose((ring)v->Data());
4842    if (res->data!=NULL)
4843    {
4844      long mm=r->wanted_maxExp;
4845      if (mm!=0) atSet(res,omStrDup("maxExp"),(void*)mm,INT_CMD);
4846      return FALSE;
4847    }
4848  }
4849  return TRUE;
4850}
4851static BOOLEAN jjRINGLIST_C(leftv res, leftv v)
4852{
4853  coeffs r=(coeffs)v->Data();
4854  if (r!=NULL)
4855    return rDecompose_CF(res,r);
4856  return TRUE;
4857}
4858static BOOLEAN jjRING_LIST(leftv res, leftv v)
4859{
4860  ring r=(ring)v->Data();
4861  if (r!=NULL)
4862    res->data = (char *)rDecompose_list_cf((ring)v->Data());
4863  return (r==NULL)||(res->data==NULL);
4864}
4865static BOOLEAN jjROWS(leftv res, leftv v)
4866{
4867  ideal i = (ideal)v->Data();
4868  res->data = (char *)i->rank;
4869  return FALSE;
4870}
4871static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4872{
4873  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4874  return FALSE;
4875}
4876static BOOLEAN jjROWS_IV(leftv res, leftv v)
4877{
4878  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4879  return FALSE;
4880}
4881static BOOLEAN jjRPAR(leftv res, leftv v)
4882{
4883  res->data = (char *)(long)rPar(((ring)v->Data()));
4884  return FALSE;
4885}
4886static BOOLEAN jjS2I(leftv res, leftv v)
4887{
4888  res->data = (char *)(long)atoi((char*)v->Data());
4889  return FALSE;
4890}
4891static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4892{
4893  const bool bIsSCA = rIsSCA(currRing);
4894
4895  if ((currRing->qideal!=NULL) && !bIsSCA)
4896  {
4897    WerrorS("qring not supported by slimgb at the moment");
4898    return TRUE;
4899  }
4900  if (rHasLocalOrMixedOrdering(currRing))
4901  {
4902    WerrorS("ordering must be global for slimgb");
4903    return TRUE;
4904  }
4905  if (rField_is_numeric(currRing))
4906    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
4907  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4908  // tHomog hom=testHomog;
4909  ideal u_id=(ideal)u->Data();
4910  if (w!=NULL)
4911  {
4912    if (!idTestHomModule(u_id,currRing->qideal,w))
4913    {
4914      WarnS("wrong weights");
4915      w=NULL;
4916    }
4917    else
4918    {
4919      w=ivCopy(w);
4920      // hom=isHomog;
4921    }
4922  }
4923
4924  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4925  res->data=(char *)t_rep_gb(currRing,
4926    u_id,u_id->rank);
4927  //res->data=(char *)t_rep_gb(currRing, u_id);
4928
4929  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4930  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4931  return FALSE;
4932}
4933static BOOLEAN jjSBA(leftv res, leftv v)
4934{
4935  ideal result;
4936  ideal v_id=(ideal)v->Data();
4937  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4938  tHomog hom=testHomog;
4939  if (w!=NULL)
4940  {
4941    if (!idTestHomModule(v_id,currRing->qideal,w))
4942    {
4943      WarnS("wrong weights");
4944      w=NULL;
4945    }
4946    else
4947    {
4948      hom=isHomog;
4949      w=ivCopy(w);
4950    }
4951  }
4952  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4953  idSkipZeroes(result);
4954  res->data = (char *)result;
4955  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4956  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4957  return FALSE;
4958}
4959static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4960{
4961  ideal result;
4962  ideal v_id=(ideal)v->Data();
4963  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4964  tHomog hom=testHomog;
4965  if (w!=NULL)
4966  {
4967    if (!idTestHomModule(v_id,currRing->qideal,w))
4968    {
4969      WarnS("wrong weights");
4970      w=NULL;
4971    }
4972    else
4973    {
4974      hom=isHomog;
4975      w=ivCopy(w);
4976    }
4977  }
4978  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4979  idSkipZeroes(result);
4980  res->data = (char *)result;
4981  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4982  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4983  return FALSE;
4984}
4985static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4986{
4987  ideal result;
4988  ideal v_id=(ideal)v->Data();
4989  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4990  tHomog hom=testHomog;
4991  if (w!=NULL)
4992  {
4993    if (!idTestHomModule(v_id,currRing->qideal,w))
4994    {
4995      WarnS("wrong weights");
4996      w=NULL;
4997    }
4998    else
4999    {
5000      hom=isHomog;
5001      w=ivCopy(w);
5002    }
5003  }
5004  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
5005  idSkipZeroes(result);
5006  res->data = (char *)result;
5007  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5008  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5009  return FALSE;
5010}
5011static BOOLEAN jjSTD(leftv res, leftv v)
5012{
5013  if (rField_is_numeric(currRing))
5014    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5015  ideal result;
5016  ideal v_id=(ideal)v->Data();
5017  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5018  tHomog hom=testHomog;
5019  if (w!=NULL)
5020  {
5021    if (!idTestHomModule(v_id,currRing->qideal,w))
5022    {
5023      WarnS("wrong weights");
5024      w=NULL;
5025    }
5026    else
5027    {
5028      hom=isHomog;
5029      w=ivCopy(w);
5030    }
5031  }
5032  result=kStd(v_id,currRing->qideal,hom,&w);
5033  idSkipZeroes(result);
5034  res->data = (char *)result;
5035  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5036  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5037  return FALSE;
5038}
5039static BOOLEAN jjSort_Id(leftv res, leftv v)
5040{
5041  res->data = (char *)idSort((ideal)v->Data());
5042  return FALSE;
5043}
5044static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5045{
5046  singclap_factorize_retry=0;
5047  intvec *v=NULL;
5048  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5049  if (f==NULL) return TRUE;
5050  ivTest(v);
5051  lists l=(lists)omAllocBin(slists_bin);
5052  l->Init(2);
5053  l->m[0].rtyp=IDEAL_CMD;
5054  l->m[0].data=(void *)f;
5055  l->m[1].rtyp=INTVEC_CMD;
5056  l->m[1].data=(void *)v;
5057  res->data=(void *)l;
5058  return FALSE;
5059}
5060#if 0
5061static BOOLEAN jjSYZYGY(leftv res, leftv v)
5062{
5063  intvec *w=NULL;
5064  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5065  if (w!=NULL) delete w;
5066  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5067  return FALSE;
5068}
5069#else
5070// activate, if idSyz handle module weights correctly !
5071static BOOLEAN jjSYZYGY(leftv res, leftv v)
5072{
5073  ideal v_id=(ideal)v->Data();
5074#ifdef HAVE_SHIFTBBA
5075  if (rIsLPRing(currRing))
5076  {
5077    if (currRing->LPncGenCount < IDELEMS(v_id))
5078    {
5079      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS(v_id));
5080      return TRUE;
5081    }
5082  }
5083#endif
5084  intvec *ww=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5085  intvec *w=NULL;
5086  tHomog hom=testHomog;
5087  if (ww!=NULL)
5088  {
5089    if (idTestHomModule(v_id,currRing->qideal,ww))
5090    {
5091      w=ivCopy(ww);
5092      int add_row_shift=w->min_in();
5093      (*w)-=add_row_shift;
5094      hom=isHomog;
5095    }
5096    else
5097    {
5098      //WarnS("wrong weights");
5099      delete ww; ww=NULL;
5100      hom=testHomog;
5101    }
5102  }
5103  else
5104  {
5105    if (v->Typ()==IDEAL_CMD)
5106      if (idHomIdeal(v_id,currRing->qideal))
5107        hom=isHomog;
5108  }
5109  ideal S=idSyzygies(v_id,hom,&w);
5110  res->data = (char *)S;
5111  if (hom==isHomog)
5112  {
5113    int vl=S->rank;
5114    intvec *vv=new intvec(vl);
5115    if ((v->Typ()==IDEAL_CMD)||(ww==NULL))
5116    {
5117      for(int i=0;i<vl;i++)
5118      {
5119        if (v_id->m[i]!=NULL)
5120          (*vv)[i]=p_Deg(v_id->m[i],currRing);
5121      }
5122    }
5123    else
5124    {
5125      p_SetModDeg(ww, currRing);
5126      for(int i=0;i<vl;i++)
5127      {
5128        if (v_id->m[i]!=NULL)
5129          (*vv)[i]=currRing->pFDeg(v_id->m[i],currRing);
5130      }
5131      p_SetModDeg(NULL, currRing);
5132    }
5133    if (idTestHomModule(S,currRing->qideal,vv))
5134      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
5135    else
5136      delete vv;
5137  }
5138  if (w!=NULL) delete w;
5139  return FALSE;
5140}
5141#endif
5142static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5143{
5144  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5145  return FALSE;
5146}
5147static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5148{
5149  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5150  return FALSE;
5151}
5152static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5153{
5154  res->data = (char *)ivTranp((intvec*)(v->Data()));
5155  return FALSE;
5156}
5157#ifdef HAVE_PLURAL
5158static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5159{
5160  ring    r = (ring)a->Data();
5161  //if (rIsPluralRing(r))
5162  if (r->OrdSgn==1)
5163  {
5164    res->data = rOpposite(r);
5165  }
5166  else
5167  {
5168    WarnS("opposite only for global orderings");
5169    res->data = rCopy(r);
5170  }
5171  return FALSE;
5172}
5173static BOOLEAN jjENVELOPE(leftv res, leftv a)
5174{
5175  ring    r = (ring)a->Data();
5176  if (rIsPluralRing(r))
5177  {
5178    ring s = rEnvelope(r);
5179    res->data = s;
5180  }
5181  else  res->data = rCopy(r);
5182  return FALSE;
5183}
5184static BOOLEAN jjTWOSTD(leftv res, leftv a)
5185{
5186  ideal result;
5187  ideal v_id=(ideal)a->Data();
5188  if (rIsPluralRing(currRing))
5189    result=(ideal)twostd(v_id);
5190  else /*commutative or shiftalgebra*/
5191  {
5192    return jjSTD(res,a);
5193  }
5194  res->data = (char *)result;
5195  setFlag(res,FLAG_STD);
5196  setFlag(res,FLAG_TWOSTD);
5197  return FALSE;
5198}
5199#endif
5200#if defined(HAVE_SHIFTBBA) || defined(HAVE_PLURAL)// do not place above jjSTD in this file because we need to reference it
5201static BOOLEAN jjRIGHTSTD(leftv res, leftv v)
5202{
5203  if (rIsLPRing(currRing))
5204  {
5205    if (rField_is_numeric(currRing))
5206      WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5207    ideal result;
5208    ideal v_id=(ideal)v->Data();
5209    /* intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD); */
5210    /* tHomog hom=testHomog; */
5211    /* if (w!=NULL) */
5212    /* { */
5213    /*   if (!idTestHomModule(v_id,currRing->qideal,w)) */
5214    /*   { */
5215    /*     WarnS("wrong weights"); */
5216    /*     w=NULL; */
5217    /*   } */
5218    /*   else */
5219    /*   { */
5220    /*     hom=isHomog; */
5221    /*     w=ivCopy(w); */
5222    /*   } */
5223    /* } */
5224    /* result=kStd(v_id,currRing->qideal,hom,&w); */
5225    result = rightgb(v_id, currRing->qideal);
5226    idSkipZeroes(result);
5227    res->data = (char *)result;
5228    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5229    /* if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD); */
5230    return FALSE;
5231  }
5232  else if (rIsPluralRing(currRing))
5233  {
5234    ideal I=(ideal)v->Data();
5235
5236    ring A = currRing;
5237    ring Aopp = rOpposite(A);
5238    currRing = Aopp;
5239    ideal Iopp = idOppose(A, I, Aopp);
5240    ideal Jopp = kStd(Iopp,currRing->qideal,testHomog,NULL);
5241    currRing = A;
5242    ideal J = idOppose(Aopp, Jopp, A);
5243
5244    id_Delete(&Iopp, Aopp);
5245    id_Delete(&Jopp, Aopp);
5246    rDelete(Aopp);
5247
5248    idSkipZeroes(J);
5249    res->data = (char *)J;
5250    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5251    return FALSE;
5252  }
5253  else
5254  {
5255    return jjSTD(res, v);
5256  }
5257}
5258#endif
5259static BOOLEAN jjTYPEOF(leftv res, leftv v)
5260{
5261  int t=(int)(long)v->data;
5262  switch (t)
5263  {
5264    case CRING_CMD:
5265    case INT_CMD:
5266    case POLY_CMD:
5267    case VECTOR_CMD:
5268    case STRING_CMD:
5269    case INTVEC_CMD:
5270    case IDEAL_CMD:
5271    case MATRIX_CMD:
5272    case MODUL_CMD:
5273    case MAP_CMD:
5274    case PROC_CMD:
5275    case RING_CMD:
5276    case SMATRIX_CMD:
5277    //case QRING_CMD:
5278    case INTMAT_CMD:
5279    case BIGINTMAT_CMD:
5280    case NUMBER_CMD:
5281    #ifdef SINGULAR_4_2
5282    case CNUMBER_CMD:
5283    #endif
5284    case BIGINT_CMD:
5285    case BUCKET_CMD:
5286    case LIST_CMD:
5287    case PACKAGE_CMD:
5288    case LINK_CMD:
5289    case RESOLUTION_CMD:
5290         res->data=omStrDup(Tok2Cmdname(t)); break;
5291    case DEF_CMD:
5292    case NONE:           res->data=omStrDup("none"); break;
5293    default:
5294    {
5295      if (t>MAX_TOK)
5296        res->data=omStrDup(getBlackboxName(t));
5297      else
5298        res->data=omStrDup("?unknown type?");
5299      break;
5300    }
5301  }
5302  return FALSE;
5303}
5304static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5305{
5306  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5307  return FALSE;
5308}
5309static BOOLEAN jjVAR1(leftv res, leftv v)
5310{
5311  int i=(int)(long)v->Data();
5312  if ((0<i) && (i<=currRing->N))
5313  {
5314    poly p=pOne();
5315    pSetExp(p,i,1);
5316    pSetm(p);
5317    res->data=(char *)p;
5318  }
5319  else
5320  {
5321    Werror("var number %d out of range 1..%d",i,currRing->N);
5322    return TRUE;
5323  }
5324  return FALSE;
5325}
5326static BOOLEAN jjVARSTR1(leftv res, leftv v)
5327{
5328  if (currRing==NULL)
5329  {
5330    WerrorS("no ring active (2)");
5331    return TRUE;
5332  }
5333  int i=(int)(long)v->Data();
5334  if ((0<i) && (i<=currRing->N))
5335    res->data=omStrDup(currRing->names[i-1]);
5336  else
5337  {
5338    Werror("var number %d out of range 1..%d",i,currRing->N);
5339    return TRUE;
5340  }
5341  return FALSE;
5342}
5343static BOOLEAN jjVDIM(leftv res, leftv v)
5344{
5345  assumeStdFlag(v);
5346  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5347  return FALSE;
5348}
5349BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5350{
5351// input: u: a list with links of type
5352//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5353// returns: -1:  the read state of all links is eof
5354//          i>0: (at least) u[i] is ready
5355  lists Lforks = (lists)u->Data();
5356  int i = slStatusSsiL(Lforks, -1);
5357  if(i == -2) /* error */
5358  {
5359    return TRUE;
5360  }
5361  res->data = (void*)(long)i;
5362  return FALSE;
5363}
5364BOOLEAN jjWAITALL1(leftv res, leftv u)
5365{
5366// input: u: a list with links of type
5367//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5368// returns: -1: the read state of all links is eof
5369//           1: all links are ready
5370//              (caution: at least one is ready, but some maybe dead)
5371  lists Lforks = (lists)u->CopyD();
5372  int i;
5373  int j = -1;
5374  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5375  {
5376    i = slStatusSsiL(Lforks, -1);
5377    if(i == -2) /* error */
5378    {
5379      return TRUE;
5380    }
5381    if(i == -1)
5382    {
5383      break;
5384    }
5385    j = 1;
5386    Lforks->m[i-1].CleanUp();
5387    Lforks->m[i-1].rtyp=DEF_CMD;
5388    Lforks->m[i-1].data=NULL;
5389  }
5390  res->data = (void*)(long)j;
5391  Lforks->Clean();
5392  return FALSE;
5393}
5394
5395BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5396{
5397  char libnamebuf[1024];
5398  lib_types LT = type_of_LIB(s, libnamebuf);
5399
5400#ifdef HAVE_DYNAMIC_LOADING
5401  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5402#endif /* HAVE_DYNAMIC_LOADING */
5403  switch(LT)
5404  {
5405      default:
5406      case LT_NONE:
5407        Werror("%s: unknown type", s);
5408        break;
5409      case LT_NOTFOUND:
5410        Werror("cannot open %s", s);
5411        break;
5412
5413      case LT_SINGULAR:
5414      {
5415        char *plib = iiConvName(s);
5416        idhdl pl = IDROOT->get_level(plib,0);
5417        if (pl==NULL)
5418        {
5419          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5420          IDPACKAGE(pl)->language = LANG_SINGULAR;
5421          IDPACKAGE(pl)->libname=omStrDup(s);
5422        }
5423        else if (IDTYP(pl)!=PACKAGE_CMD)
5424        {
5425          Werror("can not create package `%s`",plib);
5426          omFree(plib);
5427          return TRUE;
5428        }
5429        else /* package */
5430        {
5431          package pa=IDPACKAGE(pl);
5432          if ((pa->language==LANG_C)
5433          || (pa->language==LANG_MIX))
5434          {
5435            Werror("can not create package `%s` - binaries  exists",plib);
5436            omfree(plib);
5437            return TRUE;
5438          }
5439        }
5440        omFree(plib);
5441        package savepack=currPack;
5442        currPack=IDPACKAGE(pl);
5443        IDPACKAGE(pl)->loaded=TRUE;
5444        char libnamebuf[1024];
5445        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5446        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5447        currPack=savepack;
5448        IDPACKAGE(pl)->loaded=(!bo);
5449        return bo;
5450      }
5451      case LT_BUILTIN:
5452        SModulFunc_t iiGetBuiltinModInit(const char*);
5453        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5454      case LT_MACH_O:
5455      case LT_ELF:
5456      case LT_HPUX:
5457#ifdef HAVE_DYNAMIC_LOADING
5458        return load_modules(s, libnamebuf, autoexport);
5459#else /* HAVE_DYNAMIC_LOADING */
5460        WerrorS("Dynamic modules are not supported by this version of Singular");
5461        break;
5462#endif /* HAVE_DYNAMIC_LOADING */
5463  }
5464  return TRUE;
5465}
5466STATIC_VAR int WerrorS_dummy_cnt=0;
5467static void WerrorS_dummy(const char *)
5468{
5469  WerrorS_dummy_cnt++;
5470}
5471BOOLEAN jjLOAD_TRY(const char *s)
5472{
5473  if (!iiGetLibStatus(s))
5474  {
5475    void (*WerrorS_save)(const char *s) = WerrorS_callback;
5476    WerrorS_callback=WerrorS_dummy;
5477    WerrorS_dummy_cnt=0;
5478    BOOLEAN bo=jjLOAD(s,TRUE);
5479    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5480      Print("loading of >%s< failed\n",s);
5481    WerrorS_callback=WerrorS_save;
5482    errorreported=0;
5483  }
5484  return FALSE;
5485}
5486
5487static BOOLEAN jjstrlen(leftv res, leftv v)
5488{
5489  res->data = (char *)strlen((char *)v->Data());
5490  return FALSE;
5491}
5492static BOOLEAN jjpLength(leftv res, leftv v)
5493{
5494  res->data = (char *)(long)pLength((poly)v->Data());
5495  return FALSE;
5496}
5497static BOOLEAN jjidElem(leftv res, leftv v)
5498{
5499  res->data = (char *)(long)idElem((ideal)v->Data());
5500  return FALSE;
5501}
5502static BOOLEAN jjidFreeModule(leftv res, leftv v)
5503{
5504  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5505  return FALSE;
5506}
5507static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5508{
5509  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5510  return FALSE;
5511}
5512static BOOLEAN jjrCharStr(leftv res, leftv v)
5513{
5514  res->data = rCharStr((ring)v->Data());
5515  return FALSE;
5516}
5517static BOOLEAN jjpHead(leftv res, leftv v)
5518{
5519  res->data = (char *)pHead((poly)v->Data());
5520  return FALSE;
5521}
5522static BOOLEAN jjidHead(leftv res, leftv v)
5523{
5524  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5525  setFlag(res,FLAG_STD);
5526  return FALSE;
5527}
5528static BOOLEAN jjidMinBase(leftv res, leftv v)
5529{
5530  res->data = (char *)idMinBase((ideal)v->Data());
5531  return FALSE;
5532}
5533#if 0 // unused
5534static BOOLEAN jjsyMinBase(leftv res, leftv v)
5535{
5536  res->data = (char *)syMinBase((ideal)v->Data());
5537  return FALSE;
5538}
5539#endif
5540static BOOLEAN jjpMaxComp(leftv res, leftv v)
5541{
5542  res->data = (char *)pMaxComp((poly)v->Data());
5543  return FALSE;
5544}
5545static BOOLEAN jjmpTrace(leftv res, leftv v)
5546{
5547  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5548  return FALSE;
5549}
5550static BOOLEAN jjmpTransp(leftv res, leftv v)
5551{
5552  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5553  return FALSE;
5554}
5555static BOOLEAN jjrOrdStr(leftv res, leftv v)
5556{
5557  res->data = rOrdStr((ring)v->Data());
5558  return FALSE;
5559}
5560static BOOLEAN jjrVarStr(leftv res, leftv v)
5561{
5562  res->data = rVarStr((ring)v->Data());
5563  return FALSE;
5564}
5565static BOOLEAN jjrParStr(leftv res, leftv v)
5566{
5567  res->data = rParStr((ring)v->Data());
5568  return FALSE;
5569}
5570static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5571{
5572  res->data=(char *)(long)sySize((syStrategy)v->Data());
5573  return FALSE;
5574}
5575static BOOLEAN jjDIM_R(leftv res, leftv v)
5576{
5577  res->data = (char *)(long)syDim((syStrategy)v->Data());
5578  return FALSE;
5579}
5580static BOOLEAN jjidTransp(leftv res, leftv v)
5581{
5582  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5583  return FALSE;
5584}
5585static BOOLEAN jjnInt(leftv res, leftv u)
5586{
5587  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5588  res->data=(char *)(long)iin_Int(n,currRing->cf);
5589  n_Delete(&n,currRing->cf);
5590  return FALSE;
5591}
5592static BOOLEAN jjnlInt(leftv res, leftv u)
5593{
5594  number n=(number)u->Data();
5595  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5596  return FALSE;
5597}
5598/*=================== operations with 3 args.: static proc =================*/
5599/* must be ordered: first operations for chars (infix ops),
5600 * then alphabetically */
5601static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5602{
5603  char *s= (char *)u->Data();
5604  int   r = (int)(long)v->Data();
5605  int   c = (int)(long)w->Data();
5606  int l = strlen(s);
5607
5608  if ( (r<1) || (r>l) || (c<0) )
5609  {
5610    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5611    return TRUE;
5612  }
5613  res->data = (char *)omAlloc((long)(c+1));
5614  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5615  return FALSE;
5616}
5617static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5618{
5619  intvec *iv = (intvec *)u->Data();
5620  int   r = (int)(long)v->Data();
5621  int   c = (int)(long)w->Data();
5622  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5623  {
5624    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5625           r,c,u->Fullname(),iv->rows(),iv->cols());
5626    return TRUE;
5627  }
5628  res->data=u->data; u->data=NULL;
5629  res->rtyp=u->rtyp; u->rtyp=0;
5630  res->name=u->name; u->name=NULL;
5631  Subexpr e=jjMakeSub(v);
5632          e->next=jjMakeSub(w);
5633  if (u->e==NULL) res->e=e;
5634  else
5635  {
5636    Subexpr h=u->e;
5637    while (h->next!=NULL) h=h->next;
5638    h->next=e;
5639    res->e=u->e;
5640    u->e=NULL;
5641  }
5642  return FALSE;
5643}
5644static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5645{
5646  bigintmat *bim = (bigintmat *)u->Data();
5647  int   r = (int)(long)v->Data();
5648  int   c = (int)(long)w->Data();
5649  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5650  {
5651    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5652           r,c,u->Fullname(),bim->rows(),bim->cols());
5653    return TRUE;
5654  }
5655  res->data=u->data; u->data=NULL;
5656  res->rtyp=u->rtyp; u->rtyp=0;
5657  res->name=u->name; u->name=NULL;
5658  Subexpr e=jjMakeSub(v);
5659          e->next=jjMakeSub(w);
5660  if (u->e==NULL)
5661    res->e=e;
5662  else
5663  {
5664    Subexpr h=u->e;
5665    while (h->next!=NULL) h=h->next;
5666    h->next=e;
5667    res->e=u->e;
5668    u->e=NULL;
5669  }
5670  return FALSE;
5671}
5672static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5673{
5674  matrix m= (matrix)u->Data();
5675  int   r = (int)(long)v->Data();
5676  int   c = (int)(long)w->Data();
5677  //Print("gen. elem %d, %d\n",r,c);
5678  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5679  {
5680    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5681      MATROWS(m),MATCOLS(m));
5682    return TRUE;
5683  }
5684  res->data=u->data; u->data=NULL;
5685  res->rtyp=u->rtyp; u->rtyp=0;
5686  res->name=u->name; u->name=NULL;
5687  Subexpr e=jjMakeSub(v);
5688          e->next=jjMakeSub(w);
5689  if (u->e==NULL)
5690    res->e=e;
5691  else
5692  {
5693    Subexpr h=u->e;
5694    while (h->next!=NULL) h=h->next;
5695    h->next=e;
5696    res->e=u->e;
5697    u->e=NULL;
5698  }
5699  return FALSE;
5700}
5701static BOOLEAN jjBRACK_SM(leftv res, leftv u, leftv v,leftv w)
5702{
5703  ideal m= (ideal)u->Data();
5704  int   r = (int)(long)v->Data();
5705  int   c = (int)(long)w->Data();
5706  //Print("gen. elem %d, %d\n",r,c);
5707  if ((r<1)||(r>m->rank)||(c<1)||(c>IDELEMS(m)))
5708  {
5709    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5710      (int)m->rank,IDELEMS(m));
5711    return TRUE;
5712  }
5713  res->data=u->data; u->data=NULL;
5714  res->rtyp=u->rtyp; u->rtyp=0;
5715  res->name=u->name; u->name=NULL;
5716  Subexpr e=jjMakeSub(v);
5717          e->next=jjMakeSub(w);
5718  if (u->e==NULL)
5719    res->e=e;
5720  else
5721  {
5722    Subexpr h=u->e;
5723    while (h->next!=NULL) h=h->next;
5724    h->next=e;
5725    res->e=u->e;
5726    u->e=NULL;
5727  }
5728  return FALSE;
5729}
5730static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5731{
5732  sleftv t;
5733  sleftv ut;
5734  leftv p=NULL;
5735  intvec *iv=(intvec *)w->Data();
5736  int l;
5737  BOOLEAN nok;
5738
5739  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5740  {
5741    WerrorS("cannot build expression lists from unnamed objects");
5742    return TRUE;
5743  }
5744  memcpy(&ut,u,sizeof(ut));
5745  memset(&t,0,sizeof(t));
5746  t.rtyp=INT_CMD;
5747  for (l=0;l< iv->length(); l++)
5748  {
5749    t.data=(char *)(long)((*iv)[l]);
5750    if (p==NULL)
5751    {
5752      p=res;
5753    }
5754    else
5755    {
5756      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5757      p=p->next;
5758    }
5759    memcpy(u,&ut,sizeof(ut));
5760    if (u->Typ() == MATRIX_CMD)
5761      nok=jjBRACK_Ma(p,u,v,&t);
5762    else if (u->Typ() == BIGINTMAT_CMD)
5763      nok=jjBRACK_Bim(p,u,v,&t);
5764    else /* INTMAT_CMD */
5765      nok=jjBRACK_Im(p,u,v,&t);
5766    if (nok)
5767    {
5768      while (res->next!=NULL)
5769      {
5770        p=res->next->next;
5771        omFreeBin((ADDRESS)res->next, sleftv_bin);
5772        // res->e aufraeumen !!!!
5773        res->next=p;
5774      }
5775      return TRUE;
5776    }
5777  }
5778  return FALSE;
5779}
5780static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5781{
5782  sleftv t;
5783  sleftv ut;
5784  leftv p=NULL;
5785  intvec *iv=(intvec *)v->Data();
5786  int l;
5787  BOOLEAN nok;
5788
5789  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5790  {
5791    WerrorS("cannot build expression lists from unnamed objects");
5792    return TRUE;
5793  }
5794  memcpy(&ut,u,sizeof(ut));
5795  memset(&t,0,sizeof(t));
5796  t.rtyp=INT_CMD;
5797  for (l=0;l< iv->length(); l++)
5798  {
5799    t.data=(char *)(long)((*iv)[l]);
5800    if (p==NULL)
5801    {
5802      p=res;
5803    }
5804    else
5805    {
5806      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5807      p=p->next;
5808    }
5809    memcpy(u,&ut,sizeof(ut));
5810    if (u->Typ() == MATRIX_CMD)
5811      nok=jjBRACK_Ma(p,u,&t,w);
5812    else if (u->Typ() == BIGINTMAT_CMD)
5813      nok=jjBRACK_Bim(p,u,&t,w);
5814    else /* INTMAT_CMD */
5815      nok=jjBRACK_Im(p,u,&t,w);
5816    if (nok)
5817    {
5818      while (res->next!=NULL)
5819      {
5820        p=res->next->next;
5821        omFreeBin((ADDRESS)res->next, sleftv_bin);
5822        // res->e aufraeumen !!
5823        res->next=p;
5824      }
5825      return TRUE;
5826    }
5827  }
5828  return FALSE;
5829}
5830static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5831{
5832  sleftv t1,t2,ut;
5833  leftv p=NULL;
5834  intvec *vv=(intvec *)v->Data();
5835  intvec *wv=(intvec *)w->Data();
5836  int vl;
5837  int wl;
5838  BOOLEAN nok;
5839
5840  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5841  {
5842    WerrorS("cannot build expression lists from unnamed objects");
5843    return TRUE;
5844  }
5845  memcpy(&ut,u,sizeof(ut));
5846  memset(&t1,0,sizeof(sleftv));
5847  memset(&t2,0,sizeof(sleftv));
5848  t1.rtyp=INT_CMD;
5849  t2.rtyp=INT_CMD;
5850  for (vl=0;vl< vv->length(); vl++)
5851  {
5852    t1.data=(char *)(long)((*vv)[vl]);
5853    for (wl=0;wl< wv->length(); wl++)
5854    {
5855      t2.data=(char *)(long)((*wv)[wl]);
5856      if (p==NULL)
5857      {
5858        p=res;
5859      }
5860      else
5861      {
5862        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5863        p=p->next;
5864      }
5865      memcpy(u,&ut,sizeof(ut));
5866      if (u->Typ() == MATRIX_CMD)
5867        nok=jjBRACK_Ma(p,u,&t1,&t2);
5868      else if (u->Typ() == BIGINTMAT_CMD)
5869        nok=jjBRACK_Bim(p,u,&t1,&t2);
5870      else /* INTMAT_CMD */
5871        nok=jjBRACK_Im(p,u,&t1,&t2);
5872      if (nok)
5873      {
5874        res->CleanUp();
5875        return TRUE;
5876      }
5877    }
5878  }
5879  return FALSE;
5880}
5881static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5882{
5883  v->next=(leftv)omAllocBin(sleftv_bin);
5884  memcpy(v->next,w,sizeof(sleftv));
5885  memset(w,0,sizeof(sleftv));
5886  return jjPROC(res,u,v);
5887}
5888static BOOLEAN jjRING_2(leftv res, leftv u, leftv v, leftv w)
5889{
5890  u->next=(leftv)omAlloc(sizeof(sleftv));
5891  memcpy(u->next,v,sizeof(sleftv));
5892  memset(v,0,sizeof(sleftv));
5893  u->next->next=(leftv)omAlloc(sizeof(sleftv));
5894  memcpy(u->next->next,w,sizeof(sleftv));
5895  memset(w,0,sizeof(sleftv));
5896  BOOLEAN bo=iiExprArithM(res,u,'[');
5897  u->next=NULL;
5898  return bo;
5899}
5900static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5901{
5902  intvec *iv;
5903  ideal m;
5904  lists l=(lists)omAllocBin(slists_bin);
5905  int k=(int)(long)w->Data();
5906  if (k>=0)
5907  {
5908    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5909    l->Init(2);
5910    l->m[0].rtyp=MODUL_CMD;
5911    l->m[1].rtyp=INTVEC_CMD;
5912    l->m[0].data=(void *)m;
5913    l->m[1].data=(void *)iv;
5914  }
5915  else
5916  {
5917    m=sm_CallSolv((ideal)u->Data(), currRing);
5918    l->Init(1);
5919    l->m[0].rtyp=IDEAL_CMD;
5920    l->m[0].data=(void *)m;
5921  }
5922  res->data = (char *)l;
5923  return FALSE;
5924}
5925static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5926{
5927  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5928  {
5929    WerrorS("3rd argument must be a name of a matrix");
5930    return TRUE;
5931  }
5932  ideal i=(ideal)u->Data();
5933  int rank=(int)i->rank;
5934  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5935  if (r) return TRUE;
5936  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5937  return FALSE;
5938}
5939static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5940{
5941  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5942           (ideal)(v->Data()),(poly)(w->Data()));
5943  return FALSE;
5944}
5945static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5946{
5947  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5948  {
5949    WerrorS("3rd argument must be a name of a matrix");
5950    return TRUE;
5951  }
5952  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5953  poly p=(poly)u->CopyD(POLY_CMD);
5954  ideal i=idInit(1,1);
5955  i->m[0]=p;
5956  sleftv t;
5957  memset(&t,0,sizeof(t));
5958  t.data=(char *)i;
5959  t.rtyp=IDEAL_CMD;
5960  int rank=1;
5961  if (u->Typ()==VECTOR_CMD)
5962  {
5963    i->rank=rank=pMaxComp(p);
5964    t.rtyp=MODUL_CMD;
5965  }
5966  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5967  t.CleanUp();
5968  if (r) return TRUE;
5969  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5970  return FALSE;
5971}
5972static BOOLEAN jjELIMIN_ALG(leftv res, leftv u, leftv v, leftv w)
5973{
5974  ideal I=(ideal)u->Data();
5975  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
5976  res->data=(char *)idElimination(I,(poly)v->Data(),NULL,alg);
5977  //setFlag(res,FLAG_STD);
5978  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
5979}
5980static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5981{
5982  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5983    (intvec *)w->Data());
5984  //setFlag(res,FLAG_STD);
5985  return FALSE;
5986}
5987static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5988{
5989  /*4
5990  * look for the substring what in the string where
5991  * starting at position n
5992  * return the position of the first char of what in where
5993  * or 0
5994  */
5995  int n=(int)(long)w->Data();
5996  char *where=(char *)u->Data();
5997  char *what=(char *)v->Data();
5998  char *found;
5999  if ((1>n)||(n>(int)strlen(where)))
6000  {
6001    Werror("start position %d out of range",n);
6002    return TRUE;
6003  }
6004  found = strchr(where+n-1,*what);
6005  if (*(what+1)!='\0')
6006  {
6007    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
6008    {
6009      found=strchr(found+1,*what);
6010    }
6011  }
6012  if (found != NULL)
6013  {
6014    res->data=(char *)((found-where)+1);
6015  }
6016  return FALSE;
6017}
6018static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
6019{
6020  if ((int)(long)w->Data()==0)
6021    res->data=(char *)walkProc(u,v);
6022  else
6023    res->data=(char *)fractalWalkProc(u,v);
6024  setFlag( res, FLAG_STD );
6025  return FALSE;
6026}
6027static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
6028{
6029  intvec *wdegree=(intvec*)w->Data();
6030  if (wdegree->length()!=currRing->N)
6031  {
6032    Werror("weight vector must have size %d, not %d",
6033           currRing->N,wdegree->length());
6034    return TRUE;
6035  }
6036#ifdef HAVE_RINGS
6037  if (rField_is_Z(currRing))
6038  {
6039    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
6040    PrintS("//       performed for generic fibre, that is, over Q\n");
6041  }
6042#endif
6043  assumeStdFlag(u);
6044  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6045  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
6046  if (errorreported) return TRUE;
6047
6048  switch((int)(long)v->Data())
6049  {
6050    case 1:
6051      res->data=(void *)iv;
6052      return FALSE;
6053    case 2:
6054      res->data=(void *)hSecondSeries(iv);
6055      delete iv;
6056      return FALSE;
6057  }
6058  delete iv;
6059  WerrorS(feNotImplemented);
6060  return TRUE;
6061}
6062static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
6063{
6064  PrintS("TODO\n");
6065  int i=pVar((poly)v->Data());
6066  if (i==0)
6067  {
6068    WerrorS("ringvar expected");
6069    return TRUE;
6070  }
6071  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6072  int d=pWTotaldegree(p);
6073  pLmDelete(p);
6074  if (d==1)
6075    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
6076  else
6077    WerrorS("variable must have weight 1");
6078  return (d!=1);
6079}
6080static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
6081{
6082  PrintS("TODO\n");
6083  int i=pVar((poly)v->Data());
6084  if (i==0)
6085  {
6086    WerrorS("ringvar expected");
6087    return TRUE;
6088  }
6089  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6090  int d=pWTotaldegree(p);
6091  pLmDelete(p);
6092  if (d==1)
6093    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
6094  else
6095    WerrorS("variable must have weight 1");
6096  return (d!=1);
6097}
6098static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
6099{
6100  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
6101  intvec* arg = (intvec*) u->Data();
6102  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
6103
6104  for (i=0; i<n; i++)
6105  {
6106    (*im)[i] = (*arg)[i];
6107  }
6108
6109  res->data = (char *)im;
6110  return FALSE;
6111}
6112static BOOLEAN jjINTERSECT3(leftv res, leftv u, leftv v, leftv w)
6113{
6114  ideal I1=(ideal)u->Data();
6115  ideal I2=(ideal)v->Data();
6116  ideal I3=(ideal)w->Data();
6117  resolvente r=(resolvente)omAlloc0(3*sizeof(ideal));
6118  r[0]=I1;
6119  r[1]=I2;
6120  r[2]=I3;
6121  res->data=(char *)idMultSect(r,3);
6122  omFreeSize((ADDRESS)r,3*sizeof(ideal));
6123  return FALSE;
6124}
6125static BOOLEAN jjINTERSEC3S(leftv res, leftv u, leftv v, leftv w)
6126{
6127  ideal I=(ideal)u->Data();
6128  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6129  res->data=(char *)idSect(I,(ideal)v->Data(),alg);
6130  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6131  return FALSE;
6132}
6133static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
6134{
6135  short *iw=iv2array((intvec *)w->Data(),currRing);
6136  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
6137  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
6138  return FALSE;
6139}
6140static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
6141{
6142  if (!pIsUnit((poly)v->Data()))
6143  {
6144    WerrorS("2nd argument must be a unit");
6145    return TRUE;
6146  }
6147  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
6148  return FALSE;
6149}
6150static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
6151{
6152  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
6153                             (intvec *)w->Data(),currRing);
6154  return FALSE;
6155}
6156static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6157{
6158  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6159  {
6160    WerrorS("2nd argument must be a diagonal matrix of units");
6161    return TRUE;
6162  }
6163  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6164                               (matrix)v->CopyD());
6165  return FALSE;
6166}
6167static BOOLEAN jjMINOR_M(leftv res, leftv v)
6168{
6169  /* Here's the use pattern for the minor command:
6170        minor ( matrix_expression m, int_expression minorSize,
6171                optional ideal_expression IasSB, optional int_expression k,
6172                optional string_expression algorithm,
6173                optional int_expression cachedMinors,
6174                optional int_expression cachedMonomials )
6175     This method here assumes that there are at least two arguments.
6176     - If IasSB is present, it must be a std basis. All minors will be
6177       reduced w.r.t. IasSB.
6178     - If k is absent, all non-zero minors will be computed.
6179       If k is present and k > 0, the first k non-zero minors will be
6180       computed.
6181       If k is present and k < 0, the first |k| minors (some of which
6182       may be zero) will be computed.
6183       If k is present and k = 0, an error is reported.
6184     - If algorithm is absent, all the following arguments must be absent too.
6185       In this case, a heuristic picks the best-suited algorithm (among
6186       Bareiss, Laplace, and Laplace with caching).
6187       If algorithm is present, it must be one of "Bareiss", "bareiss",
6188       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6189       "cache" two more arguments may be given, determining how many entries
6190       the cache may have at most, and how many cached monomials there are at
6191       most. (Cached monomials are counted over all cached polynomials.)
6192       If these two additional arguments are not provided, 200 and 100000
6193       will be used as defaults.
6194  */
6195  matrix m;
6196  leftv u=v->next;
6197  v->next=NULL;
6198  int v_typ=v->Typ();
6199  if (v_typ==MATRIX_CMD)
6200  {
6201     m = (const matrix)v->Data();
6202  }
6203  else
6204  {
6205    if (v_typ==0)
6206    {
6207      Werror("`%s` is undefined",v->Fullname());
6208      return TRUE;
6209    }
6210    // try to convert to MATRIX:
6211    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6212    BOOLEAN bo;
6213    sleftv tmp;
6214    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6215    else bo=TRUE;
6216    if (bo)
6217    {
6218      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6219      return TRUE;
6220    }
6221    m=(matrix)tmp.data;
6222  }
6223  const int mk = (const int)(long)u->Data();
6224  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6225  bool noCacheMinors = true; bool noCacheMonomials = true;
6226  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6227
6228  /* here come the different cases of correct argument sets */
6229  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6230  {
6231    IasSB = (ideal)u->next->Data();
6232    noIdeal = false;
6233    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6234    {
6235      k = (int)(long)u->next->next->Data();
6236      noK = false;
6237      if ((u->next->next->next != NULL) &&
6238          (u->next->next->next->Typ() == STRING_CMD))
6239      {
6240        algorithm = (char*)u->next->next->next->Data();
6241        noAlgorithm = false;
6242        if ((u->next->next->next->next != NULL) &&
6243            (u->next->next->next->next->Typ() == INT_CMD))
6244        {
6245          cacheMinors = (int)(long)u->next->next->next->next->Data();
6246          noCacheMinors = false;
6247          if ((u->next->next->next->next->next != NULL) &&
6248              (u->next->next->next->next->next->Typ() == INT_CMD))
6249          {
6250            cacheMonomials =
6251               (int)(long)u->next->next->next->next->next->Data();
6252            noCacheMonomials = false;
6253          }
6254        }
6255      }
6256    }
6257  }
6258  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6259  {
6260    k = (int)(long)u->next->Data();
6261    noK = false;
6262    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6263    {
6264      algorithm = (char*)u->next->next->Data();
6265      noAlgorithm = false;
6266      if ((u->next->next->next != NULL) &&
6267          (u->next->next->next->Typ() == INT_CMD))
6268      {
6269        cacheMinors = (int)(long)u->next->next->next->Data();
6270        noCacheMinors = false;
6271        if ((u->next->next->next->next != NULL) &&
6272            (u->next->next->next->next->Typ() == INT_CMD))
6273        {
6274          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6275          noCacheMonomials = false;
6276        }
6277      }
6278    }
6279  }
6280  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6281  {
6282    algorithm = (char*)u->next->Data();
6283    noAlgorithm = false;
6284    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6285    {
6286      cacheMinors = (int)(long)u->next->next->Data();
6287      noCacheMinors = false;
6288      if ((u->next->next->next != NULL) &&
6289          (u->next->next->next->Typ() == INT_CMD))
6290      {
6291        cacheMonomials = (int)(long)u->next->next->next->Data();
6292        noCacheMonomials = false;
6293      }
6294    }
6295  }
6296
6297  /* upper case conversion for the algorithm if present */
6298  if (!noAlgorithm)
6299  {
6300    if (strcmp(algorithm, "bareiss") == 0)
6301      algorithm = (char*)"Bareiss";
6302    if (strcmp(algorithm, "laplace") == 0)
6303      algorithm = (char*)"Laplace";
6304    if (strcmp(algorithm, "cache") == 0)
6305      algorithm = (char*)"Cache";
6306  }
6307
6308  v->next=u;
6309  /* here come some tests */
6310  if (!noIdeal)
6311  {
6312    assumeStdFlag(u->next);
6313  }
6314  if ((!noK) && (k == 0))
6315  {
6316    WerrorS("Provided number of minors to be computed is zero.");
6317    return TRUE;
6318  }
6319  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6320      && (strcmp(algorithm, "Laplace") != 0)
6321      && (strcmp(algorithm, "Cache") != 0))
6322  {
6323    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6324    return TRUE;
6325  }
6326  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6327      && (!rField_is_Domain(currRing)))
6328  {
6329    Werror("Bareiss algorithm not defined over coefficient rings %s",
6330           "with zero divisors.");
6331    return TRUE;
6332  }
6333  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6334  {
6335    ideal I=idInit(1,1);
6336    if (mk<1) I->m[0]=p_One(currRing);
6337    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6338    //       m->rows(), m->cols());
6339    res->data=(void*)I;
6340    return FALSE;
6341  }
6342  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6343      && (noCacheMinors || noCacheMonomials))
6344  {
6345    cacheMinors = 200;
6346    cacheMonomials = 100000;
6347  }
6348
6349  /* here come the actual procedure calls */
6350  if (noAlgorithm)
6351    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6352                                       (noIdeal ? 0 : IasSB), false);
6353  else if (strcmp(algorithm, "Cache") == 0)
6354    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6355                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6356                                   cacheMonomials, false);
6357  else
6358    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6359                              (noIdeal ? 0 : IasSB), false);
6360  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6361  return FALSE;
6362}
6363static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6364{
6365  // u: the name of the new type
6366  // v: the parent type
6367  // w: the elements
6368  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6369                                            (const char *)w->Data());
6370  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6371  return (d==NULL);
6372}
6373static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6374{
6375  // handles preimage(r,phi,i) and kernel(r,phi)
6376  idhdl h;
6377  ring rr;
6378  map mapping;
6379  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6380
6381  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6382  {
6383    WerrorS("2nd/3rd arguments must have names");
6384    return TRUE;
6385  }
6386  rr=(ring)u->Data();
6387  const char *ring_name=u->Name();
6388  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6389  {
6390    if (h->typ==MAP_CMD)
6391    {
6392      mapping=IDMAP(h);
6393      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6394      if ((preim_ring==NULL)
6395      || (IDRING(preim_ring)!=currRing))
6396      {
6397        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6398        return TRUE;
6399      }
6400    }
6401    else if (h->typ==IDEAL_CMD)
6402    {
6403      mapping=IDMAP(h);
6404    }
6405    else
6406    {
6407      Werror("`%s` is no map nor ideal",IDID(h));
6408      return TRUE;
6409    }
6410  }
6411  else
6412  {
6413    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6414    return TRUE;
6415  }
6416  ideal image;
6417  if (kernel_cmd) image=idInit(1,1);
6418  else
6419  {
6420    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6421    {
6422      if (h->typ==IDEAL_CMD)
6423      {
6424        image=IDIDEAL(h);
6425      }
6426      else
6427      {
6428        Werror("`%s` is no ideal",IDID(h));
6429        return TRUE;
6430      }
6431    }
6432    else
6433    {
6434      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6435      return TRUE;
6436    }
6437  }
6438  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering(currRing)))
6439  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6440  {
6441    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6442  }
6443  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6444  if (kernel_cmd) idDelete(&image);
6445  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6446}
6447static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6448{
6449  int di, k;
6450  int i=(int)(long)u->Data();
6451  int r=(int)(long)v->Data();
6452  int c=(int)(long)w->Data();
6453  if ((r<=0) || (c<=0)) return TRUE;
6454  intvec *iv = new intvec(r, c, 0);
6455  if (iv->rows()==0)
6456  {
6457    delete iv;
6458    return TRUE;
6459  }
6460  if (i!=0)
6461  {
6462    if (i<0) i = -i;
6463    di = 2 * i + 1;
6464    for (k=0; k<iv->length(); k++)
6465    {
6466      (*iv)[k] = ((siRand() % di) - i);
6467    }
6468  }
6469  res->data = (char *)iv;
6470  return FALSE;
6471}
6472#ifdef SINGULAR_4_2
6473static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6474// <coeff>, par1, par2 -> number2
6475{
6476  coeffs cf=(coeffs)u->Data();
6477  if ((cf==NULL) ||(cf->cfRandom==NULL))
6478  {
6479    Werror("no random function defined for coeff %d",cf->type);
6480    return TRUE;
6481  }
6482  else
6483  {
6484    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6485    number2 nn=(number2)omAlloc(sizeof(*nn));
6486    nn->cf=cf;
6487    nn->n=n;
6488    res->data=nn;
6489    return FALSE;
6490  }
6491  return TRUE;
6492}
6493#endif
6494static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6495  int &ringvar, poly &monomexpr)
6496{
6497  monomexpr=(poly)w->Data();
6498  poly p=(poly)v->Data();
6499#if 0
6500  if (pLength(monomexpr)>1)
6501  {
6502    Werror("`%s` substitutes a ringvar only by a term",
6503      Tok2Cmdname(SUBST_CMD));
6504    return TRUE;
6505  }
6506#endif
6507  if ((ringvar=pVar(p))==0)
6508  {
6509    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6510    {
6511      number n = pGetCoeff(p);
6512      ringvar= -n_IsParam(n, currRing);
6513    }
6514    if(ringvar==0)
6515    {
6516      WerrorS("ringvar/par expected");
6517      return TRUE;
6518    }
6519  }
6520  return FALSE;
6521}
6522static BOOLEAN jjSUBST_Bu(leftv res, leftv u, leftv v,leftv w)
6523{
6524  // generic conversion from polyBucket to poly:
6525  // force this to be the first try everytime
6526  poly p; int l;
6527  sBucket_pt bu=(sBucket_pt)w->CopyD();
6528  sBucketDestroyAdd(bu,&p,&l);
6529  sleftv tmpw;
6530  tmpw.Init();
6531  tmpw.rtyp=POLY_CMD;
6532  tmpw.data=p;
6533  return iiExprArith3(res, iiOp, u, v, &tmpw);
6534}
6535static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6536{
6537  int ringvar;
6538  poly monomexpr;
6539  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6540  if (nok) return TRUE;
6541  poly p=(poly)u->Data();
6542  if (ringvar>0)
6543  {
6544    int mm=p_MaxExpPerVar(p,ringvar,currRing);
6545    if ((monomexpr!=NULL) && (p!=NULL) && (mm!=0) &&
6546    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)mm/2)))
6547    {
6548      Warn("possible OVERFLOW in subst, max exponent is %ld, substituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), mm);
6549      //return TRUE;
6550    }
6551    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6552      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6553    else
6554      res->data= pSubstPoly(p,ringvar,monomexpr);
6555  }
6556  else
6557  {
6558#ifdef HAVE_SHIFTBBA
6559    if (rIsLPRing(currRing))
6560    {
6561      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6562      return TRUE;
6563    }
6564#endif
6565    res->data=pSubstPar(p,-ringvar,monomexpr);
6566  }
6567  return FALSE;
6568}
6569static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6570{
6571  int ringvar;
6572  poly monomexpr;
6573  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6574  if (nok) return TRUE;
6575  ideal id=(ideal)u->Data();
6576  if (ringvar>0)
6577  {
6578    BOOLEAN overflow=FALSE;
6579    if (monomexpr!=NULL)
6580    {
6581      long deg_monexp=pTotaldegree(monomexpr);
6582      for(int i=IDELEMS(id)-1;i>=0;i--)
6583      {
6584        poly p=id->m[i];
6585        int mm=p_MaxExpPerVar(p,ringvar,currRing);
6586        if ((p!=NULL) && (mm!=0) &&
6587        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)mm/2)))
6588        {
6589          overflow=TRUE;
6590          break;
6591        }
6592      }
6593    }
6594    if (overflow)
6595      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6596    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6597    {
6598      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6599      else                       id=id_Copy(id,currRing);
6600      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6601    }
6602    else
6603      res->data = idSubstPoly(id,ringvar,monomexpr);
6604  }
6605  else
6606  {
6607#ifdef HAVE_SHIFTBBA
6608    if (rIsLPRing(currRing))
6609    {
6610      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6611      return TRUE;
6612    }
6613#endif
6614    res->data = idSubstPar(id,-ringvar,monomexpr);
6615  }
6616  return FALSE;
6617}
6618// we do not want to have jjSUBST_Id_X inlined:
6619static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6620                            int input_type);
6621static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6622{
6623  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6624}
6625static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6626{
6627  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6628}
6629static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6630{
6631  sleftv tmp;
6632  memset(&tmp,0,sizeof(tmp));
6633  // do not check the result, conversion from int/number to poly works always
6634  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6635  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6636  tmp.CleanUp();
6637  return b;
6638}
6639static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6640{
6641  int mi=(int)(long)v->Data();
6642  int ni=(int)(long)w->Data();
6643  if ((mi<1)||(ni<1))
6644  {
6645    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6646    return TRUE;
6647  }
6648  matrix m=mpNew(mi,ni);
6649  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6650  int i=si_min(IDELEMS(I),mi*ni);
6651  //for(i=i-1;i>=0;i--)
6652  //{
6653  //  m->m[i]=I->m[i];
6654  //  I->m[i]=NULL;
6655  //}
6656  memcpy(m->m,I->m,i*sizeof(poly));
6657  memset(I->m,0,i*sizeof(poly));
6658  id_Delete(&I,currRing);
6659  res->data = (char *)m;
6660  return FALSE;
6661}
6662static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6663{
6664  int mi=(int)(long)v->Data();
6665  int ni=(int)(long)w->Data();
6666  if ((mi<0)||(ni<1))
6667  {
6668    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6669    return TRUE;
6670  }
6671  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6672           mi,ni,currRing);
6673  return FALSE;
6674}
6675static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6676{
6677  int mi=(int)(long)v->Data();
6678  int ni=(int)(long)w->Data();
6679  if ((mi<1)||(ni<1))
6680  {
6681     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6682    return TRUE;
6683  }
6684  matrix m=mpNew(mi,ni);
6685  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6686  int r=si_min(MATROWS(I),mi);
6687  int c=si_min(MATCOLS(I),ni);
6688  int i,j;
6689  for(i=r;i>0;i--)
6690  {
6691    for(j=c;j>0;j--)
6692    {
6693      MATELEM(m,i,j)=MATELEM(I,i,j);
6694      MATELEM(I,i,j)=NULL;
6695    }
6696  }
6697  id_Delete((ideal *)&I,currRing);
6698  res->data = (char *)m;
6699  return FALSE;
6700}
6701static BOOLEAN jjSMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6702{
6703  int mi=(int)(long)v->Data();
6704  int ni=(int)(long)w->Data();
6705  if ((mi<0)||(ni<1))
6706  {
6707    Werror("converting to smatrix: dimensions must be positive(%dx%d)",mi,ni);
6708    return TRUE;
6709  }
6710  res->data = (char *)id_ResizeModule((ideal)u->CopyD(),
6711           mi,ni,currRing);
6712  return FALSE;
6713}
6714static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6715{
6716  if (w->rtyp!=IDHDL) return TRUE;
6717  int ul= IDELEMS((ideal)u->Data());
6718  int vl= IDELEMS((ideal)v->Data());
6719#ifdef HAVE_SHIFTBBA
6720  if (rIsLPRing(currRing))
6721  {
6722    if (currRing->LPncGenCount < ul)
6723    {
6724      Werror("At least %d ncgen variables are needed for this computation.", ul);
6725      return TRUE;
6726    }
6727  }
6728#endif
6729  ideal m
6730    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6731             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6732  if (m==NULL) return TRUE;
6733  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6734  return FALSE;
6735}
6736static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6737{
6738  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6739  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6740  idhdl hv=(idhdl)v->data;
6741  idhdl hw=(idhdl)w->data;
6742#ifdef HAVE_SHIFTBBA
6743  if (rIsLPRing(currRing))
6744  {
6745    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
6746    {
6747      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
6748      return TRUE;
6749    }
6750  }
6751#endif
6752  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6753  res->data = (char *)idLiftStd((ideal)u->Data(),
6754                                &(hv->data.umatrix),testHomog,
6755                                &(hw->data.uideal));
6756  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6757  return FALSE;
6758}
6759static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6760{
6761  assumeStdFlag(v);
6762  if (!idIsZeroDim((ideal)v->Data()))
6763  {
6764    Werror("`%s` must be 0-dimensional",v->Name());
6765    return TRUE;
6766  }
6767  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6768    (poly)w->CopyD());
6769  return FALSE;
6770}
6771static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6772{
6773  assumeStdFlag(v);
6774  if (!idIsZeroDim((ideal)v->Data()))
6775  {
6776    Werror("`%s` must be 0-dimensional",v->Name());
6777    return TRUE;
6778  }
6779  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6780    (matrix)w->CopyD());
6781  return FALSE;
6782}
6783static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6784{
6785  assumeStdFlag(v);
6786  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
6787    0,(int)(long)w->Data());
6788  return FALSE;
6789}
6790static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6791{
6792  assumeStdFlag(v);
6793  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
6794    0,(int)(long)w->Data());
6795  return FALSE;
6796}
6797#ifdef OLD_RES
6798static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6799{
6800  int maxl=(int)v->Data();
6801  ideal u_id=(ideal)u->Data();
6802  int l=0;
6803  resolvente r;
6804  intvec **weights=NULL;
6805  int wmaxl=maxl;
6806  maxl--;
6807  unsigned save_opt=si_opt_1;
6808  si_opt_1 |= Sy_bit(OPT_REDTAIL_SYZ);
6809  if ((maxl==-1) && (iiOp!=MRES_CMD))
6810    maxl = currRing->N-1;
6811  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6812  {
6813    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6814    if (iv!=NULL)
6815    {
6816      l=1;
6817      if (!idTestHomModule(u_id,currRing->qideal,iv))
6818      {
6819        WarnS("wrong weights");
6820        iv=NULL;
6821      }
6822      else
6823      {
6824        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6825        weights[0] = ivCopy(iv);
6826      }
6827    }
6828    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6829  }
6830  else
6831    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6832  if (r==NULL) return TRUE;
6833  int t3=u->Typ();
6834  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6835  si_opt_1=save_opt;
6836  return FALSE;
6837}
6838#endif
6839static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6840{
6841  res->data=(void *)rInit(u,v,w);
6842  return (res->data==NULL);
6843}
6844static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6845{
6846  int yes;
6847  jjSTATUS2(res, u, v);
6848  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6849  omFree((ADDRESS) res->data);
6850  res->data = (void *)(long)yes;
6851  return FALSE;
6852}
6853static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6854{
6855  intvec *vw=(intvec *)w->Data(); // weights of vars
6856  if (vw->length()!=currRing->N)
6857  {
6858    Werror("%d weights for %d variables",vw->length(),currRing->N);
6859    return TRUE;
6860  }
6861  ideal result;
6862  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6863  tHomog hom=testHomog;
6864  ideal u_id=(ideal)(u->Data());
6865  if (ww!=NULL)
6866  {
6867    if (!idTestHomModule(u_id,currRing->qideal,ww))
6868    {
6869      WarnS("wrong weights");
6870      ww=NULL;
6871    }
6872    else
6873    {
6874      ww=ivCopy(ww);
6875      hom=isHomog;
6876    }
6877  }
6878  result=kStd(u_id,
6879              currRing->qideal,
6880              hom,
6881              &ww,                  // module weights
6882              (intvec *)v->Data(),  // hilbert series
6883              0,0,                  // syzComp, newIdeal
6884              vw);                  // weights of vars
6885  idSkipZeroes(result);
6886  res->data = (char *)result;
6887  setFlag(res,FLAG_STD);
6888  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6889  return FALSE;
6890}
6891
6892/*=================== operations with many arg.: static proc =================*/
6893/* must be ordered: first operations for chars (infix ops),
6894 * then alphabetically */
6895static BOOLEAN jjBREAK0(leftv, leftv)
6896{
6897#ifdef HAVE_SDB
6898  sdb_show_bp();
6899#endif
6900  return FALSE;
6901}
6902static BOOLEAN jjBREAK1(leftv, leftv v)
6903{
6904#ifdef HAVE_SDB
6905  if(v->Typ()==PROC_CMD)
6906  {
6907    int lineno=0;
6908    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6909    {
6910      lineno=(int)(long)v->next->Data();
6911    }
6912    return sdb_set_breakpoint(v->Name(),lineno);
6913  }
6914  return TRUE;
6915#else
6916 return FALSE;
6917#endif
6918}
6919static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6920{
6921  return iiExprArith1(res,v,iiOp);
6922}
6923static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6924{
6925  leftv v=u->next;
6926  u->next=NULL;
6927  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6928  u->next=v;
6929  return b;
6930}
6931static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6932{
6933  leftv v = u->next;
6934  leftv w = v->next;
6935  u->next = NULL;
6936  v->next = NULL;
6937  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6938  u->next = v;
6939  v->next = w;
6940  return b;
6941}
6942
6943static BOOLEAN jjCOEF_M(leftv, leftv v)
6944{
6945  const short t[]={4,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD};
6946  if (iiCheckTypes(v,t,1))
6947  {
6948    idhdl c=(idhdl)v->next->next->data;
6949    if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6950    idhdl m=(idhdl)v->next->next->next->data;
6951    idDelete((ideal *)&(c->data.uideal));
6952    idDelete((ideal *)&(m->data.uideal));
6953    mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6954      (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6955    return FALSE;
6956  }
6957  return TRUE;
6958}
6959
6960static BOOLEAN jjDIVISION4(leftv res, leftv v)
6961{ // may have 3 or 4 arguments
6962  leftv v1=v;
6963  leftv v2=v1->next;
6964  leftv v3=v2->next;
6965  leftv v4=v3->next;
6966  assumeStdFlag(v2);
6967
6968  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6969  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6970
6971  if((i1==0)||(i2==0)
6972  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6973  {
6974    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6975    return TRUE;
6976  }
6977
6978  sleftv w1,w2;
6979  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6980  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6981  ideal P=(ideal)w1.Data();
6982  ideal Q=(ideal)w2.Data();
6983
6984  int n=(int)(long)v3->Data();
6985  short *w=NULL;
6986  if(v4!=NULL)
6987  {
6988    w = iv2array((intvec *)v4->Data(),currRing);
6989    short * w0 = w + 1;
6990    int i = currRing->N;
6991    while( (i > 0) && ((*w0) > 0) )
6992    {
6993      w0++;
6994      i--;
6995    }
6996    if(i>0)
6997      WarnS("not all weights are positive!");
6998  }
6999
7000  matrix T;
7001  ideal R;
7002  idLiftW(P,Q,n,T,R,w);
7003
7004  w1.CleanUp();
7005  w2.CleanUp();
7006  if(w!=NULL)
7007    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
7008
7009  lists L=(lists) omAllocBin(slists_bin);
7010  L->Init(2);
7011  L->m[1].rtyp=v1->Typ();
7012  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
7013  {
7014    if(v1->Typ()==POLY_CMD)
7015      p_Shift(&R->m[0],-1,currRing);
7016    L->m[1].data=(void *)R->m[0];
7017    R->m[0]=NULL;
7018    idDelete(&R);
7019  }
7020  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
7021    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
7022  else
7023  {
7024    L->m[1].rtyp=MODUL_CMD;
7025    L->m[1].data=(void *)R;
7026  }
7027  L->m[0].rtyp=MATRIX_CMD;
7028  L->m[0].data=(char *)T;
7029
7030  res->data=L;
7031
7032  return FALSE;
7033}
7034
7035//BOOLEAN jjDISPATCH(leftv res, leftv v)
7036//{
7037//  WerrorS("`dispatch`: not implemented");
7038//  return TRUE;
7039//}
7040
7041//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
7042//{
7043//  int l=u->listLength();
7044//  if (l<2) return TRUE;
7045//  BOOLEAN b;
7046//  leftv v=u->next;
7047//  leftv zz=v;
7048//  leftv z=zz;
7049//  u->next=NULL;
7050//  do
7051//  {
7052//    leftv z=z->next;
7053//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
7054//    if (b) break;
7055//  } while (z!=NULL);
7056//  u->next=zz;
7057//  return b;
7058//}
7059static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
7060{
7061  int s=1;
7062  leftv h=v;
7063  if (h!=NULL) s=exprlist_length(h);
7064  ideal id=idInit(s,1);
7065  int rank=1;
7066  int i=0;
7067  poly p;
7068  int dest_type=POLY_CMD;
7069  if (iiOp==MODUL_CMD) dest_type=VECTOR_CMD;
7070  while (h!=NULL)
7071  {
7072    // use standard type conversions to poly/vector
7073    int ri;
7074    int ht=h->Typ();
7075    if (ht==dest_type)
7076    {
7077      p=(poly)h->CopyD();
7078      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7079    }
7080    else if ((ri=iiTestConvert(ht,dest_type,dConvertTypes))!=0)
7081    {
7082      sleftv tmp;
7083      leftv hnext=h->next;
7084      h->next=NULL;
7085      iiConvert(ht,dest_type,ri,h,&tmp,dConvertTypes);
7086      h->next=hnext;
7087      p=(poly)tmp.data;
7088      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7089    }
7090    else
7091    {
7092      idDelete(&id);
7093      return TRUE;
7094    }
7095    id->m[i]=p;
7096    i++;
7097    h=h->next;
7098  }
7099  id->rank=rank;
7100  res->data=(char *)id;
7101  return FALSE;
7102}
7103static BOOLEAN jjFETCH_M(leftv res, leftv u)
7104{
7105  ring r=(ring)u->Data();
7106  leftv v=u->next;
7107  leftv perm_var_l=v->next;
7108  leftv perm_par_l=v->next->next;
7109  if ((perm_var_l->Typ()!=INTVEC_CMD)
7110  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
7111  ||(u->Typ()!=RING_CMD))
7112  {
7113    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
7114    return TRUE;
7115  }
7116  intvec *perm_var_v=(intvec*)perm_var_l->Data();
7117  intvec *perm_par_v=NULL;
7118  if (perm_par_l!=NULL)
7119    perm_par_v=(intvec*)perm_par_l->Data();
7120  idhdl w;
7121  nMapFunc nMap;
7122
7123  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
7124  {
7125    int *perm=NULL;
7126    int *par_perm=NULL;
7127    int par_perm_size=0;
7128    BOOLEAN bo;
7129    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
7130    {
7131      // Allow imap/fetch to be make an exception only for:
7132      if (nCoeff_is_Extension(r->cf) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
7133         ((n_SetMap(r->cf->extRing->cf,currRing->cf)!=NULL)
7134         || (nCoeff_is_Extension(currRing->cf) && (n_SetMap(r->cf->extRing->cf,currRing->cf->extRing->cf)!=NULL))))
7135      {
7136        par_perm_size=rPar(r);
7137      }
7138      else
7139      {
7140        goto err_fetch;
7141      }
7142    }
7143    else
7144      par_perm_size=rPar(r);
7145    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
7146    if (par_perm_size!=0)
7147      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
7148    int i;
7149    if (perm_par_l==NULL)
7150    {
7151      if (par_perm_size!=0)
7152        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
7153    }
7154    else
7155    {
7156      if (par_perm_size==0) WarnS("source ring has no parameters");
7157      else
7158      {
7159        for(i=rPar(r)-1;i>=0;i--)
7160        {
7161          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
7162          if ((par_perm[i]<-rPar(currRing))
7163          || (par_perm[i]>rVar(currRing)))
7164          {
7165            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
7166            par_perm[i]=0;
7167          }
7168        }
7169      }
7170    }
7171    for(i=rVar(r)-1;i>=0;i--)
7172    {
7173      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
7174      if ((perm[i]<-rPar(currRing))
7175      || (perm[i]>rVar(currRing)))
7176      {
7177        Warn("invalid entry for var %d: %d\n",i,perm[i]);
7178        perm[i]=0;
7179      }
7180    }
7181    if (BVERBOSE(V_IMAP))
7182    {
7183      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
7184      {
7185        if (perm[i]>0)
7186          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
7187        else if (perm[i]<0)
7188          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
7189      }
7190      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
7191      {
7192        if (par_perm[i-1]<0)
7193          Print("// par nr %d: %s -> par %s\n",
7194              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
7195        else if (par_perm[i-1]>0)
7196          Print("// par nr %d: %s -> var %s\n",
7197              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7198      }
7199    }
7200    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7201    sleftv tmpW;
7202    memset(&tmpW,0,sizeof(sleftv));
7203    tmpW.rtyp=IDTYP(w);
7204    tmpW.data=IDDATA(w);
7205    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7206                         perm,par_perm,par_perm_size,nMap)))
7207    {
7208      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7209    }
7210    if (perm!=NULL)
7211      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7212    if (par_perm!=NULL)
7213      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7214    return bo;
7215  }
7216  else
7217  {
7218    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7219  }
7220  return TRUE;
7221err_fetch:
7222  char *s1=nCoeffString(r->cf);
7223  char *s2=nCoeffString(currRing->cf);
7224  Werror("no identity map from %s (%s -> %s)",u->Fullname(),s1,s2);
7225  omFree(s2);omFree(s1);
7226  return TRUE;
7227}
7228static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7229{
7230  leftv h=v;
7231  int l=v->listLength();
7232  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7233  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7234  int t=0;
7235  // try to convert to IDEAL_CMD
7236  while (h!=NULL)
7237  {
7238    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7239    {
7240      t=IDEAL_CMD;
7241    }
7242    else break;
7243    h=h->next;
7244  }
7245  // if failure, try MODUL_CMD
7246  if (t==0)
7247  {
7248    h=v;
7249    while (h!=NULL)
7250    {
7251      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7252      {
7253        t=MODUL_CMD;
7254      }
7255      else break;
7256      h=h->next;
7257    }
7258  }
7259  // check for success  in converting
7260  if (t==0)
7261  {
7262    WerrorS("cannot convert to ideal or module");
7263    return TRUE;
7264  }
7265  // call idMultSect
7266  h=v;
7267  int i=0;
7268  sleftv tmp;
7269  while (h!=NULL)
7270  {
7271    if (h->Typ()==t)
7272    {
7273      r[i]=(ideal)h->Data(); /*no copy*/
7274      h=h->next;
7275    }
7276    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7277    {
7278      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7279      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7280      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7281      return TRUE;
7282    }
7283    else
7284    {
7285      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7286      copied[i]=TRUE;
7287      h=tmp.next;
7288    }
7289    i++;
7290  }
7291  res->rtyp=t;
7292  res->data=(char *)idMultSect(r,i);
7293  while(i>0)
7294  {
7295    i--;
7296    if (copied[i]) idDelete(&(r[i]));
7297  }
7298  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7299  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7300  return FALSE;
7301}
7302static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7303{
7304  /* computation of the inverse of a quadratic matrix A
7305     using the L-U-decomposition of A;
7306     There are two valid parametrisations:
7307     1) exactly one argument which is just the matrix A,
7308     2) exactly three arguments P, L, U which already
7309        realise the L-U-decomposition of A, that is,
7310        P * A = L * U, and P, L, and U satisfy the
7311        properties decribed in method 'jjLU_DECOMP';
7312        see there;
7313     If A is invertible, the list [1, A^(-1)] is returned,
7314     otherwise the list [0] is returned. Thus, the user may
7315     inspect the first entry of the returned list to see
7316     whether A is invertible. */
7317  matrix iMat; int invertible;
7318  const short t1[]={1,MATRIX_CMD};
7319  const short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7320  if (iiCheckTypes(v,t1))
7321  {
7322    matrix aMat = (matrix)v->Data();
7323    int rr = aMat->rows();
7324    int cc = aMat->cols();
7325    if (rr != cc)
7326    {
7327      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7328      return TRUE;
7329    }
7330    if (!idIsConstant((ideal)aMat))
7331    {
7332      WerrorS("matrix must be constant");
7333      return TRUE;
7334    }
7335    invertible = luInverse(aMat, iMat);
7336  }
7337  else if (iiCheckTypes(v,t2))
7338  {
7339     matrix pMat = (matrix)v->Data();
7340     matrix lMat = (matrix)v->next->Data();
7341     matrix uMat = (matrix)v->next->next->Data();
7342     int rr = uMat->rows();
7343     int cc = uMat->cols();
7344     if (rr != cc)
7345     {
7346       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7347              rr, cc);
7348       return TRUE;
7349     }
7350      if (!idIsConstant((ideal)pMat)
7351      || (!idIsConstant((ideal)lMat))
7352      || (!idIsConstant((ideal)uMat))
7353      )
7354      {
7355        WerrorS("matricesx must be constant");
7356        return TRUE;
7357      }
7358     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7359  }
7360  else
7361  {
7362    Werror("expected either one or three matrices");
7363    return TRUE;
7364  }
7365
7366  /* build the return structure; a list with either one or two entries */
7367  lists ll = (lists)omAllocBin(slists_bin);
7368  if (invertible)
7369  {
7370    ll->Init(2);
7371    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7372    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7373  }
7374  else
7375  {
7376    ll->Init(1);
7377    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7378  }
7379
7380  res->data=(char*)ll;
7381  return FALSE;
7382}
7383static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7384{
7385  /* for solving a linear equation system A * x = b, via the
7386     given LU-decomposition of the matrix A;
7387     There is one valid parametrisation:
7388     1) exactly four arguments P, L, U, b;
7389        P, L, and U realise the L-U-decomposition of A, that is,
7390        P * A = L * U, and P, L, and U satisfy the
7391        properties decribed in method 'jjLU_DECOMP';
7392        see there;
7393        b is the right-hand side vector of the equation system;
7394     The method will return a list of either 1 entry or three entries:
7395     1) [0] if there is no solution to the system;
7396     2) [1, x, H] if there is at least one solution;
7397        x is any solution of the given linear system,
7398        H is the matrix with column vectors spanning the homogeneous
7399        solution space.
7400     The method produces an error if matrix and vector sizes do not fit. */
7401  const short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7402  if (!iiCheckTypes(v,t))
7403  {
7404    WerrorS("expected exactly three matrices and one vector as input");
7405    return TRUE;
7406  }
7407  matrix pMat = (matrix)v->Data();
7408  matrix lMat = (matrix)v->next->Data();
7409  matrix uMat = (matrix)v->next->next->Data();
7410  matrix bVec = (matrix)v->next->next->next->Data();
7411  matrix xVec; int solvable; matrix homogSolSpace;
7412  if (pMat->rows() != pMat->cols())
7413  {
7414    Werror("first matrix (%d x %d) is not quadratic",
7415           pMat->rows(), pMat->cols());
7416    return TRUE;
7417  }
7418  if (lMat->rows() != lMat->cols())
7419  {
7420    Werror("second matrix (%d x %d) is not quadratic",
7421           lMat->rows(), lMat->cols());
7422    return TRUE;
7423  }
7424  if (lMat->rows() != uMat->rows())
7425  {
7426    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7427           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7428    return TRUE;
7429  }
7430  if (uMat->rows() != bVec->rows())
7431  {
7432    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7433           uMat->rows(), uMat->cols(), bVec->rows());
7434    return TRUE;
7435  }
7436  if (!idIsConstant((ideal)pMat)
7437  ||(!idIsConstant((ideal)lMat))
7438  ||(!idIsConstant((ideal)uMat))
7439  )
7440  {
7441    WerrorS("matrices must be constant");
7442    return TRUE;
7443  }
7444  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7445
7446  /* build the return structure; a list with either one or three entries */
7447  lists ll = (lists)omAllocBin(slists_bin);
7448  if (solvable)
7449  {
7450    ll->Init(3);
7451    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7452    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7453    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7454  }
7455  else
7456  {
7457    ll->Init(1);
7458    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7459  }
7460
7461  res->data=(char*)ll;
7462  return FALSE;
7463}
7464static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7465{
7466  int i=0;
7467  leftv h=v;
7468  if (h!=NULL) i=exprlist_length(h);
7469  intvec *iv=new intvec(i);
7470  i=0;
7471  while (h!=NULL)
7472  {
7473    if(h->Typ()==INT_CMD)
7474    {
7475      (*iv)[i]=(int)(long)h->Data();
7476    }
7477    else if (h->Typ()==INTVEC_CMD)
7478    {
7479      intvec *ivv=(intvec*)h->Data();
7480      for(int j=0;j<ivv->length();j++,i++)
7481      {
7482        (*iv)[i]=(*ivv)[j];
7483      }
7484      i--;
7485    }
7486    else
7487    {
7488      delete iv;
7489      return TRUE;
7490    }
7491    i++;
7492    h=h->next;
7493  }
7494  res->data=(char *)iv;
7495  return FALSE;
7496}
7497static BOOLEAN jjJET4(leftv res, leftv u)
7498{
7499  const short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7500  const short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7501  const short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7502  const short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7503  leftv u1=u;
7504  leftv u2=u1->next;
7505  leftv u3=u2->next;
7506  leftv u4=u3->next;
7507  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7508  {
7509    if(!pIsUnit((poly)u2->Data()))
7510    {
7511      WerrorS("2nd argument must be a unit");
7512      return TRUE;
7513    }
7514    res->rtyp=u1->Typ();
7515    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7516                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7517    return FALSE;
7518  }
7519  else
7520  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7521  {
7522    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7523    {
7524      WerrorS("2nd argument must be a diagonal matrix of units");
7525      return TRUE;
7526    }
7527    res->rtyp=u1->Typ();
7528    res->data=(char*)idSeries(
7529                              (int)(long)u3->Data(),
7530                              idCopy((ideal)u1->Data()),
7531                              mp_Copy((matrix)u2->Data(), currRing),
7532                              (intvec*)u4->Data()
7533                             );
7534    return FALSE;
7535  }
7536  else
7537  {
7538    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7539           Tok2Cmdname(iiOp));
7540    return TRUE;
7541  }
7542}
7543#if 0
7544static BOOLEAN jjBRACKET_PL(leftv res, leftv u)
7545{
7546  int ut=u->Typ();
7547  leftv v=u->next; u->next=NULL;
7548  leftv w=v->next; v->next=NULL;
7549  if ((ut!=CRING_CMD)&&(ut!=RING_CMD))
7550  {
7551    BOOLEAN bo=TRUE;
7552    if (w==NULL)
7553    {
7554      bo=iiExprArith2(res,u,'[',v);
7555    }
7556    else if (w->next==NULL)
7557    {
7558      bo=iiExprArith3(res,'[',u,v,w);
7559    }
7560    v->next=w;
7561    u->next=v;
7562    return bo;
7563  }
7564  v->next=w;
7565  u->next=v;
7566  #ifdef SINGULAR_4_1
7567  // construct new rings:
7568  while (u!=NULL)
7569  {
7570    Print("name: %s,\n",u->Name());
7571    u=u->next;
7572  }
7573  #else
7574  memset(res,0,sizeof(sleftv));
7575  res->rtyp=NONE;
7576  return TRUE;
7577  #endif
7578}
7579#endif
7580static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7581{
7582  if ((yyInRingConstruction)
7583  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7584  {
7585    memcpy(res,u,sizeof(sleftv));
7586    memset(u,0,sizeof(sleftv));
7587    return FALSE;
7588  }
7589  leftv v=u->next;
7590  BOOLEAN b;
7591  if(v==NULL)  // p()
7592    b=iiExprArith1(res,u,iiOp);
7593  else if ((v->next==NULL) // p(1)
7594  || (u->Typ()!=UNKNOWN))  // p(1,2), p proc or map
7595  {
7596    u->next=NULL;
7597    b=iiExprArith2(res,u,iiOp,v);
7598    u->next=v;
7599  }
7600  else // p(1,2), p undefined
7601  {
7602    if (v->Typ()!=INT_CMD)
7603    {
7604      Werror("`int` expected while building `%s(`",u->name);
7605      return TRUE;
7606    }
7607    int l=u->listLength();
7608    char * nn = (char *)omAlloc(strlen(u->name) + 12*l);
7609    sprintf(nn,"%s(%d",u->name,(int)(long)v->Data());
7610    char *s=nn;
7611    do
7612    {
7613      while (*s!='\0') s++;
7614      v=v->next;
7615      if (v->Typ()!=INT_CMD)
7616      {
7617        Werror("`int` expected while building `%s`",nn);
7618        omFree((ADDRESS)nn);
7619        return TRUE;
7620      }
7621      sprintf(s,",%d",(int)(long)v->Data());
7622    } while (v->next!=NULL);
7623    while (*s!='\0') s++;
7624    nn=strcat(nn,")");
7625    char *n=omStrDup(nn);
7626    omFree((ADDRESS)nn);
7627    syMake(res,n);
7628    b=FALSE;
7629  }
7630  return b;
7631}
7632static BOOLEAN jjLIFT_4(leftv res, leftv U)
7633{
7634  const short t1[]={4,IDEAL_CMD,IDEAL_CMD,MATRIX_CMD,STRING_CMD};
7635  const short t2[]={4,MODUL_CMD,MODUL_CMD,MATRIX_CMD,STRING_CMD};
7636  leftv u=U;
7637  leftv v=u->next;
7638  leftv w=v->next;
7639  leftv u4=w->next;
7640  if (w->rtyp!=IDHDL) return TRUE;
7641  if (iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7642  {
7643    // see jjLIFT3
7644    ideal I=(ideal)u->Data();
7645    int ul= IDELEMS(I /*(ideal)u->Data()*/);
7646    int vl= IDELEMS((ideal)v->Data());
7647    GbVariant alg=syGetAlgorithm((char*)u4->Data(),currRing,I);
7648    ideal m
7649    = idLift(I,(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
7650             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))),alg);
7651    if (m==NULL) return TRUE;
7652    res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
7653    return FALSE;
7654  }
7655  else
7656  {
7657    Werror("%s(`ideal`,`ideal`,`matrix`,`string`)\n"
7658           "or (`module`,`module`,`matrix`,`string`) expected",
7659           Tok2Cmdname(iiOp));
7660    return TRUE;
7661  }
7662}
7663static BOOLEAN jjLIFTSTD_4(leftv res, leftv U)
7664{
7665  const short t1[]={4,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7666  const short t2[]={4,MODUL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7667  leftv u=U;
7668  leftv v=u->next;
7669  leftv w=v->next;
7670  leftv u4=w->next;
7671  if (v->rtyp!=IDHDL) return TRUE;
7672  if (w->rtyp!=IDHDL) return TRUE;
7673  if (iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7674  {
7675    // see jjLIFTSTD3
7676    ideal I=(ideal)u->Data();
7677    idhdl hv=(idhdl)v->data;
7678    idhdl hw=(idhdl)w->data;
7679    GbVariant alg=syGetAlgorithm((char*)u4->Data(),currRing,I);
7680    // CopyD for IDEAL_CMD and MODUL_CMD are identical:
7681    res->data = (char *)idLiftStd((ideal)u->Data(),
7682                                &(hv->data.umatrix),testHomog,
7683                                &(hw->data.uideal),alg);
7684    setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
7685    return FALSE;
7686  }
7687  else
7688  {
7689    Werror("%s(`ideal`,`matrix`,`module`,`string`)\n"
7690           "or (`module`,`matrix`,`module`,`string`) expected",
7691           Tok2Cmdname(iiOp));
7692    return TRUE;
7693  }
7694}
7695BOOLEAN jjLIST_PL(leftv res, leftv v)
7696{
7697  int sl=0;
7698  if (v!=NULL) sl = v->listLength();
7699  lists L;
7700  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7701  {
7702    int add_row_shift = 0;
7703    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7704    if (weights!=NULL)  add_row_shift=weights->min_in();
7705    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7706  }
7707  else
7708  {
7709    L=(lists)omAllocBin(slists_bin);
7710    leftv h=NULL;
7711    int i;
7712    int rt;
7713
7714    L->Init(sl);
7715    for (i=0;i<sl;i++)
7716    {
7717      if (h!=NULL)
7718      { /* e.g. not in the first step:
7719         * h is the pointer to the old sleftv,
7720         * v is the pointer to the next sleftv
7721         * (in this moment) */
7722         h->next=v;
7723      }
7724      h=v;
7725      v=v->next;
7726      h->next=NULL;
7727      rt=h->Typ();
7728      if (rt==0)
7729      {
7730        L->Clean();
7731        Werror("`%s` is undefined",h->Fullname());
7732        return TRUE;
7733      }
7734      if (rt==RING_CMD)
7735      {
7736        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7737        ((ring)L->m[i].data)->ref++;
7738      }
7739      else
7740        L->m[i].Copy(h);
7741    }
7742  }
7743  res->data=(char *)L;
7744  return FALSE;
7745}
7746static BOOLEAN jjNAMES0(leftv res, leftv)
7747{
7748  res->data=(void *)ipNameList(IDROOT);
7749  return FALSE;
7750}
7751static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7752{
7753  if(v==NULL)
7754  {
7755    res->data=(char *)showOption();
7756    return FALSE;
7757  }
7758  res->rtyp=NONE;
7759  return setOption(res,v);
7760}
7761static BOOLEAN jjREDUCE4(leftv res, leftv u)
7762{
7763  leftv u1=u;
7764  leftv u2=u1->next;
7765  leftv u3=u2->next;
7766  leftv u4=u3->next;
7767  int u1t=u1->Typ(); if (u1t==BUCKET_CMD) u1t=POLY_CMD;
7768  int u2t=u2->Typ(); if (u2t==BUCKET_CMD) u2t=POLY_CMD;
7769  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7770  {
7771    int save_d=Kstd1_deg;
7772    Kstd1_deg=(int)(long)u3->Data();
7773    kModW=(intvec *)u4->Data();
7774    BITSET save2;
7775    SI_SAVE_OPT2(save2);
7776    si_opt_2|=Sy_bit(V_DEG_STOP);
7777    u2->next=NULL;
7778    BOOLEAN r=jjCALL2ARG(res,u);
7779    kModW=NULL;
7780    Kstd1_deg=save_d;
7781    SI_RESTORE_OPT2(save2);
7782    u->next->next=u3;
7783    return r;
7784  }
7785  else
7786  if((u1t==IDEAL_CMD)&&(u2t==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7787     (u4->Typ()==INT_CMD))
7788  {
7789    assumeStdFlag(u3);
7790    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7791    {
7792      WerrorS("2nd argument must be a diagonal matrix of units");
7793      return TRUE;
7794    }
7795    res->data=(char*)redNF(
7796                           idCopy((ideal)u3->Data()),
7797                           idCopy((ideal)u1->Data()),
7798                           mp_Copy((matrix)u2->Data(), currRing),
7799                           (int)(long)u4->Data()
7800                          );
7801    return FALSE;
7802  }
7803  else
7804  if((u1t==POLY_CMD)&&(u2t==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7805     (u4->Typ()==INT_CMD))
7806  {
7807    poly u1p;
7808    if (u1->Typ()==BUCKET_CMD) u1p=sBucketPeek((sBucket_pt)u1->Data());
7809    else                     u1p=(poly)u1->Data();
7810    poly u2p;
7811    if (u2->Typ()==BUCKET_CMD) u2p=sBucketPeek((sBucket_pt)u2->Data());
7812    else                     u2p=(poly)u2->Data();
7813    assumeStdFlag(u3);
7814    if(!pIsUnit(u2p))
7815    {
7816      WerrorS("2nd argument must be a unit");
7817      return TRUE;
7818    }
7819    res->rtyp=POLY_CMD;
7820    res->data=(char*)redNF((ideal)u3->CopyD(),pCopy(u1p),
7821                           pCopy(u2p),(int)(long)u4->Data());
7822    return FALSE;
7823  }
7824  else
7825  {
7826    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7827    Werror("%s(`ideal`,`matrix`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
7828    Werror("%s(`poly`,`poly`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
7829    return TRUE;
7830  }
7831}
7832static BOOLEAN jjREDUCE5(leftv res, leftv u)
7833{
7834  leftv u1=u;
7835  leftv u2=u1->next;
7836  leftv u3=u2->next;
7837  leftv u4=u3->next;
7838  leftv u5=u4->next;
7839  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7840     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7841  {
7842    assumeStdFlag(u3);
7843    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7844    {
7845      WerrorS("2nd argument must be a diagonal matrix of units");
7846      return TRUE;
7847    }
7848    res->data=(char*)redNF(
7849                           idCopy((ideal)u3->Data()),
7850                           idCopy((ideal)u1->Data()),
7851                           mp_Copy((matrix)u2->Data(),currRing),
7852                           (int)(long)u4->Data(),
7853                           (intvec*)u5->Data()
7854                          );
7855    return FALSE;
7856  }
7857  else
7858  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7859     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7860  {
7861    assumeStdFlag(u3);
7862    if(!pIsUnit((poly)u2->Data()))
7863    {
7864      WerrorS("2nd argument must be a unit");
7865      return TRUE;
7866    }
7867    res->rtyp=POLY_CMD;
7868    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7869                           pCopy((poly)u2->Data()),
7870                           (int)(long)u4->Data(),(intvec*)u5->Data());
7871    return FALSE;
7872  }
7873  else
7874  {
7875    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7876           Tok2Cmdname(iiOp));
7877    return TRUE;
7878  }
7879}
7880static BOOLEAN jjRESERVED0(leftv, leftv)
7881{
7882  unsigned i=1;
7883  unsigned nCount = (sArithBase.nCmdUsed-1)/3;
7884  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7885  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7886  //      sArithBase.nCmdAllocated);
7887  for(i=0; i<nCount; i++)
7888  {
7889    Print("%-20s",sArithBase.sCmds[i+1].name);
7890    if(i+1+nCount<sArithBase.nCmdUsed)
7891      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7892    if(i+1+2*nCount<sArithBase.nCmdUsed)
7893      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7894    //if ((i%3)==1) PrintLn();
7895    PrintLn();
7896  }
7897  PrintLn();
7898  printBlackboxTypes();
7899  return FALSE;
7900}
7901
7902static BOOLEAN jjRESERVEDLIST0(leftv res, leftv)
7903{
7904        unsigned i=1;
7905        int l = 0;
7906        int k = 0;
7907        lists L = (lists)omAllocBin(slists_bin);
7908        struct blackbox_list *bb_list = NULL;
7909        unsigned nCount = (sArithBase.nCmdUsed-1) / 3;
7910
7911        if ((3*nCount) < sArithBase.nCmdUsed) {
7912                nCount++;
7913        }
7914        bb_list = getBlackboxTypes();
7915        // count the  number of entries;
7916        for (i=0; i<nCount; i++) {
7917                l++;
7918                if (i + 1 + nCount < sArithBase.nCmdUsed) {
7919                        l++;
7920                }
7921                if(i+1+2*nCount<sArithBase.nCmdUsed) {
7922                        l++;
7923                }
7924        }
7925        for (i = 0; i < bb_list->count; i++) {
7926                if (bb_list->list[i] != NULL) {
7927                        l++;
7928                }
7929        }
7930        // initiate list
7931        L->Init(l);
7932        k = 0;
7933        for (i=0; i<nCount; i++) {
7934                L->m[k].rtyp = STRING_CMD;
7935                L->m[k].data = omStrDup(sArithBase.sCmds[i+1].name);
7936                k++;
7937                // Print("%-20s", sArithBase.sCmds[i+1].name);
7938                if (i + 1 + nCount < sArithBase.nCmdUsed) {
7939                        L->m[k].rtyp = STRING_CMD;
7940                        L->m[k].data = omStrDup(sArithBase.sCmds[i+1+nCount].name);
7941                        k++;
7942                        // Print("%-20s", sArithBase.sCmds[i+1 + nCount].name);
7943                }
7944                if(i+1+2*nCount<sArithBase.nCmdUsed) {
7945                        L->m[k].rtyp = STRING_CMD;
7946                        L->m[k].data = omStrDup(sArithBase.sCmds[i+1+2*nCount].name);
7947                        k++;
7948                        // Print("%-20s", sArithBase.sCmds[i+1+2*nCount].name);
7949                }
7950                // PrintLn();
7951        }
7952
7953        // assign blackbox types
7954        for (i = 0; i < bb_list->count; i++) {
7955                if (bb_list->list[i] != NULL) {
7956                        L->m[k].rtyp = STRING_CMD;
7957                        // already used strdup in getBlackBoxTypes
7958                        L->m[k].data = bb_list->list[i];
7959                        k++;
7960                }
7961        }
7962        // free the struct (not the list entries itself, which were allocated
7963        // by strdup)
7964        omfree(bb_list->list);
7965        omfree(bb_list);
7966
7967        // pass the resultant list to the res datastructure
7968        res->data=(void *)L;
7969
7970        return FALSE;
7971}
7972static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7973{
7974  if (v == NULL)
7975  {
7976    res->data = omStrDup("");
7977    return FALSE;
7978  }
7979  int n = v->listLength();
7980  if (n == 1)
7981  {
7982    res->data = v->String();
7983    return FALSE;
7984  }
7985
7986  char** slist = (char**) omAlloc(n*sizeof(char*));
7987  int i, j;
7988
7989  for (i=0, j=0; i<n; i++, v = v ->next)
7990  {
7991    slist[i] = v->String();
7992    assume(slist[i] != NULL);
7993    j+=strlen(slist[i]);
7994  }
7995  char* s = (char*) omAlloc((j+1)*sizeof(char));
7996  *s='\0';
7997  for (i=0;i<n;i++)
7998  {
7999    strcat(s, slist[i]);
8000    omFree(slist[i]);
8001  }
8002  omFreeSize(slist, n*sizeof(char*));
8003  res->data = s;
8004  return FALSE;
8005}
8006static BOOLEAN jjTEST(leftv, leftv v)
8007{
8008  do
8009  {
8010    if (v->Typ()!=INT_CMD)
8011      return TRUE;
8012    test_cmd((int)(long)v->Data());
8013    v=v->next;
8014  }
8015  while (v!=NULL);
8016  return FALSE;
8017}
8018
8019#if defined(__alpha) && !defined(linux)
8020extern "C"
8021{
8022  void usleep(unsigned long usec);
8023};
8024#endif
8025static BOOLEAN jjFactModD_M(leftv res, leftv v)
8026{
8027  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
8028     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
8029
8030     valid argument lists:
8031     - (poly h, int d),
8032     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
8033     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
8034                                                          in list of ring vars,
8035     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
8036                                                optional: all 4 optional args
8037     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
8038      by singclap_factorize and h(0, y)
8039      has exactly two distinct monic factors [possibly with exponent > 1].)
8040     result:
8041     - list with the two factors f and g such that
8042       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
8043
8044  poly h      = NULL;
8045  int  d      =    1;
8046  poly f0     = NULL;
8047  poly g0     = NULL;
8048  int  xIndex =    1;   /* default index if none provided */
8049  int  yIndex =    2;   /* default index if none provided */
8050
8051  leftv u = v; int factorsGiven = 0;
8052  if ((u == NULL) || (u->Typ() != POLY_CMD))
8053  {
8054    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8055    return TRUE;
8056  }
8057  else h = (poly)u->Data();
8058  u = u->next;
8059  if ((u == NULL) || (u->Typ() != INT_CMD))
8060  {
8061    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8062    return TRUE;
8063  }
8064  else d = (int)(long)u->Data();
8065  u = u->next;
8066  if ((u != NULL) && (u->Typ() == POLY_CMD))
8067  {
8068    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
8069    {
8070      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8071      return TRUE;
8072    }
8073    else
8074    {
8075      f0 = (poly)u->Data();
8076      g0 = (poly)u->next->Data();
8077      factorsGiven = 1;
8078      u = u->next->next;
8079    }
8080  }
8081  if ((u != NULL) && (u->Typ() == INT_CMD))
8082  {
8083    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
8084    {
8085      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8086      return TRUE;
8087    }
8088    else
8089    {
8090      xIndex = (int)(long)u->Data();
8091      yIndex = (int)(long)u->next->Data();
8092      u = u->next->next;
8093    }
8094  }
8095  if (u != NULL)
8096  {
8097    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8098    return TRUE;
8099  }
8100
8101  /* checks for provided arguments */
8102  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
8103  {
8104    WerrorS("expected non-constant polynomial argument(s)");
8105    return TRUE;
8106  }
8107  int n = rVar(currRing);
8108  if ((xIndex < 1) || (n < xIndex))
8109  {
8110    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
8111    return TRUE;
8112  }
8113  if ((yIndex < 1) || (n < yIndex))
8114  {
8115    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
8116    return TRUE;
8117  }
8118  if (xIndex == yIndex)
8119  {
8120    WerrorS("expected distinct indices for variables x and y");
8121    return TRUE;
8122  }
8123
8124  /* computation of f0 and g0 if missing */
8125  if (factorsGiven == 0)
8126  {
8127    poly h0 = pSubst(pCopy(h), xIndex, NULL);
8128    intvec* v = NULL;
8129    ideal i = singclap_factorize(h0, &v, 0,currRing);
8130
8131    ivTest(v);
8132
8133    if (i == NULL) return TRUE;
8134
8135    idTest(i);
8136
8137    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
8138    {
8139      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
8140      return TRUE;
8141    }
8142    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
8143    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
8144    idDelete(&i);
8145  }
8146
8147  poly f; poly g;
8148  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
8149  lists L = (lists)omAllocBin(slists_bin);
8150  L->Init(2);
8151  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
8152  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
8153  res->rtyp = LIST_CMD;
8154  res->data = (char*)L;
8155  return FALSE;
8156}
8157static BOOLEAN jjSTATUS_M(leftv res, leftv v)
8158{
8159  if ((v->Typ() != LINK_CMD) ||
8160      (v->next->Typ() != STRING_CMD) ||
8161      (v->next->next->Typ() != STRING_CMD) ||
8162      (v->next->next->next->Typ() != INT_CMD))
8163    return TRUE;
8164  jjSTATUS3(res, v, v->next, v->next->next);
8165#if defined(HAVE_USLEEP)
8166  if (((long) res->data) == 0L)
8167  {
8168    int i_s = (int)(long) v->next->next->next->Data();
8169    if (i_s > 0)
8170    {
8171      usleep((int)(long) v->next->next->next->Data());
8172      jjSTATUS3(res, v, v->next, v->next->next);
8173    }
8174  }
8175#elif defined(HAVE_SLEEP)
8176  if (((int) res->data) == 0)
8177  {
8178    int i_s = (int) v->next->next->next->Data();
8179    if (i_s > 0)
8180    {
8181      si_sleep((is - 1)/1000000 + 1);
8182      jjSTATUS3(res, v, v->next, v->next->next);
8183    }
8184  }
8185#endif
8186  return FALSE;
8187}
8188static BOOLEAN jjSUBST_M(leftv res, leftv u)
8189{
8190  leftv v = u->next; // number of args > 0
8191  if (v==NULL) return TRUE;
8192  leftv w = v->next;
8193  if (w==NULL) return TRUE;
8194  leftv rest = w->next;
8195
8196  u->next = NULL;
8197  v->next = NULL;
8198  w->next = NULL;
8199  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
8200  if ((rest!=NULL) && (!b))
8201  {
8202    sleftv tmp_res;
8203    leftv tmp_next=res->next;
8204    res->next=rest;
8205    memset(&tmp_res,0,sizeof(tmp_res));
8206    b = iiExprArithM(&tmp_res,res,iiOp);
8207    memcpy(res,&tmp_res,sizeof(tmp_res));
8208    res->next=tmp_next;
8209  }
8210  u->next = v;
8211  v->next = w;
8212  // rest was w->next, but is already cleaned
8213  return b;
8214}
8215static BOOLEAN jjQRDS(leftv res, leftv INPUT)
8216{
8217  if ((INPUT->Typ() != MATRIX_CMD) ||
8218      (INPUT->next->Typ() != NUMBER_CMD) ||
8219      (INPUT->next->next->Typ() != NUMBER_CMD) ||
8220      (INPUT->next->next->next->Typ() != NUMBER_CMD))
8221  {
8222    WerrorS("expected (matrix, number, number, number) as arguments");
8223    return TRUE;
8224  }
8225  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
8226  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
8227                                    (number)(v->Data()),
8228                                    (number)(w->Data()),
8229                                    (number)(x->Data()));
8230  return FALSE;
8231}
8232static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
8233{ ideal result;
8234  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
8235  leftv v = u->next;  /* one additional polynomial or ideal */
8236  leftv h = v->next;  /* Hilbert vector */
8237  leftv w = h->next;  /* weight vector */
8238  assumeStdFlag(u);
8239  ideal i1=(ideal)(u->Data());
8240  ideal i0;
8241  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
8242  || (h->Typ()!=INTVEC_CMD)
8243  || (w->Typ()!=INTVEC_CMD))
8244  {
8245    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8246    return TRUE;
8247  }
8248  intvec *vw=(intvec *)w->Data(); // weights of vars
8249  /* merging std_hilb_w and std_1 */
8250  if (vw->length()!=currRing->N)
8251  {
8252    Werror("%d weights for %d variables",vw->length(),currRing->N);
8253    return TRUE;
8254  }
8255  int r=v->Typ();
8256  BOOLEAN cleanup_i0=FALSE;
8257  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
8258  {
8259    i0=idInit(1,i1->rank);
8260    i0->m[0]=(poly)v->Data();
8261    cleanup_i0=TRUE;
8262  }
8263  else if (r==IDEAL_CMD)/* IDEAL */
8264  {
8265    i0=(ideal)v->Data();
8266  }
8267  else
8268  {
8269    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8270    return TRUE;
8271  }
8272  int ii0=idElem(i0);
8273  i1 = idSimpleAdd(i1,i0);
8274  if (cleanup_i0)
8275  {
8276    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
8277    idDelete(&i0);
8278  }
8279  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8280  tHomog hom=testHomog;
8281  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
8282  if (ww!=NULL)
8283  {
8284    if (!idTestHomModule(i1,currRing->qideal,ww))
8285    {
8286      WarnS("wrong weights");
8287      ww=NULL;
8288    }
8289    else
8290    {
8291      ww=ivCopy(ww);
8292      hom=isHomog;
8293    }
8294  }
8295  BITSET save1;
8296  SI_SAVE_OPT1(save1);
8297  si_opt_1|=Sy_bit(OPT_SB_1);
8298  result=kStd(i1,
8299              currRing->qideal,
8300              hom,
8301              &ww,                  // module weights
8302              (intvec *)h->Data(),  // hilbert series
8303              0,                    // syzComp, whatever it is...
8304              IDELEMS(i1)-ii0,      // new ideal
8305              vw);                  // weights of vars
8306  SI_RESTORE_OPT1(save1);
8307  idDelete(&i1);
8308  idSkipZeroes(result);
8309  res->data = (char *)result;
8310  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
8311  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
8312  return FALSE;
8313}
8314
8315static BOOLEAN jjRING_PL(leftv res, leftv a)
8316{
8317  //Print("construct ring\n");
8318  if (a->Typ()!=CRING_CMD)
8319  {
8320    WerrorS("expected `cring` [ `id` ... ]");
8321    return TRUE;
8322  }
8323  assume(a->next!=NULL);
8324  leftv names=a->next;
8325  int N=names->listLength();
8326  char **n=(char**)omAlloc0(N*sizeof(char*));
8327  for(int i=0; i<N;i++,names=names->next)
8328  {
8329    n[i]=(char *)names->Name();
8330  }
8331  coeffs cf=(coeffs)a->CopyD();
8332  res->data=rDefault(cf,N,n, ringorder_dp);
8333  omFreeSize(n,N*sizeof(char*));
8334  return FALSE;
8335}
8336
8337static Subexpr jjMakeSub(leftv e)
8338{
8339  assume( e->Typ()==INT_CMD );
8340  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
8341  r->start =(int)(long)e->Data();
8342  return r;
8343}
8344static BOOLEAN jjRESTART(leftv, leftv u)
8345{
8346  int c=(int)(long)u->Data();
8347  switch(c)
8348  {
8349    case 0:{
8350        PrintS("delete all variables\n");
8351        killlocals(0);
8352        WerrorS("restarting...");
8353        break;
8354      };
8355    default: WerrorS("not implemented");
8356  }
8357  return FALSE;
8358}
8359#define D(A)    (A)
8360#define NULL_VAL NULL
8361#define IPARITH
8362#include "table.h"
8363
8364#include "iparith.inc"
8365
8366/*=================== operations with 2 args. ============================*/
8367/* must be ordered: first operations for chars (infix ops),
8368 * then alphabetically */
8369
8370static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
8371                                    BOOLEAN proccall,
8372                                    const struct sValCmd2* dA2,
8373                                    int at, int bt,
8374                                    const struct sConvertTypes *dConvertTypes)
8375{
8376  memset(res,0,sizeof(sleftv));
8377  BOOLEAN call_failed=FALSE;
8378
8379  if (!errorreported)
8380  {
8381    int i=0;
8382    iiOp=op;
8383    while (dA2[i].cmd==op)
8384    {
8385      if ((at==dA2[i].arg1)
8386      && (bt==dA2[i].arg2))
8387      {
8388        res->rtyp=dA2[i].res;
8389        if (currRing!=NULL)
8390        {
8391          if (check_valid(dA2[i].valid_for,op)) break;
8392        }
8393        else
8394        {
8395          if (RingDependend(dA2[i].res))
8396          {
8397            WerrorS("no ring active (3)");
8398            break;
8399          }
8400        }
8401        if (traceit&TRACE_CALL)
8402          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
8403        if ((call_failed=dA2[i].p(res,a,b)))
8404        {
8405          break;// leave loop, goto error handling
8406        }
8407        a->CleanUp();
8408        b->CleanUp();
8409        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8410        return FALSE;
8411      }
8412      i++;
8413    }
8414    // implicite type conversion ----------------------------------------------
8415    if (dA2[i].cmd!=op)
8416    {
8417      int ai,bi;
8418      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8419      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8420      BOOLEAN failed=FALSE;
8421      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8422      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8423      while (dA2[i].cmd==op)
8424      {
8425        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8426        if ((dA2[i].valid_for & NO_CONVERSION)==0)
8427        {
8428          if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8429          {
8430            if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8431            {
8432              res->rtyp=dA2[i].res;
8433              if (currRing!=NULL)
8434              {
8435                if (check_valid(dA2[i].valid_for,op)) break;
8436              }
8437              else
8438              {
8439                if (RingDependend(dA2[i].res))
8440                {
8441                  WerrorS("no ring active (4)");
8442                  break;
8443                }
8444              }
8445              if (traceit&TRACE_CALL)
8446                Print("call %s(%s,%s)\n",iiTwoOps(op),
8447                Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8448              failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8449              || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8450              || (call_failed=dA2[i].p(res,an,bn)));
8451              // everything done, clean up temp. variables
8452              if (failed)
8453              {
8454                // leave loop, goto error handling
8455                break;
8456              }
8457              else
8458              {
8459                // everything ok, clean up and return
8460                an->CleanUp();
8461                bn->CleanUp();
8462                omFreeBin((ADDRESS)an, sleftv_bin);
8463                omFreeBin((ADDRESS)bn, sleftv_bin);
8464                return FALSE;
8465              }
8466            }
8467          }
8468        }
8469        i++;
8470      }
8471      an->CleanUp();
8472      bn->CleanUp();
8473      omFreeBin((ADDRESS)an, sleftv_bin);
8474      omFreeBin((ADDRESS)bn, sleftv_bin);
8475    }
8476    // error handling ---------------------------------------------------
8477    const char *s=NULL;
8478    if (!errorreported)
8479    {
8480      if ((at==0) && (a->Fullname()!=sNoName_fe))
8481      {
8482        s=a->Fullname();
8483      }
8484      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8485      {
8486        s=b->Fullname();
8487      }
8488      if (s!=NULL)
8489        Werror("`%s` is not defined",s);
8490      else
8491      {
8492        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8493        s = iiTwoOps(op);
8494        if (proccall)
8495        {
8496          Werror("%s(`%s`,`%s`) failed"
8497                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8498        }
8499        else
8500        {
8501          Werror("`%s` %s `%s` failed"
8502                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8503        }
8504        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8505        {
8506          while (dA2[i].cmd==op)
8507          {
8508            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8509            && (dA2[i].res!=0)
8510            && (dA2[i].p!=jjWRONG2))
8511            {
8512              if (proccall)
8513                Werror("expected %s(`%s`,`%s`)"
8514                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8515              else
8516                Werror("expected `%s` %s `%s`"
8517                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8518            }
8519            i++;
8520          }
8521        }
8522      }
8523    }
8524    a->CleanUp();
8525    b->CleanUp();
8526    res->rtyp = UNKNOWN;
8527  }
8528  return TRUE;
8529}
8530BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8531                                    const struct sValCmd2* dA2,
8532                                    int at,
8533                                    const struct sConvertTypes *dConvertTypes)
8534{
8535  leftv b=a->next;
8536  a->next=NULL;
8537  int bt=b->Typ();
8538  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8539  a->next=b;
8540  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8541  return bo;
8542}
8543BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8544{
8545  memset(res,0,sizeof(sleftv));
8546
8547  if (!errorreported)
8548  {
8549#ifdef SIQ
8550    if (siq>0)
8551    {
8552      //Print("siq:%d\n",siq);
8553      command d=(command)omAlloc0Bin(sip_command_bin);
8554      memcpy(&d->arg1,a,sizeof(sleftv));
8555      a->Init();
8556      memcpy(&d->arg2,b,sizeof(sleftv));
8557      b->Init();
8558      d->argc=2;
8559      d->op=op;
8560      res->data=(char *)d;
8561      res->rtyp=COMMAND;
8562      return FALSE;
8563    }
8564#endif
8565    int at=a->Typ();
8566    int bt=b->Typ();
8567    // handling bb-objects ----------------------------------------------------
8568    if (at>MAX_TOK)
8569    {
8570      blackbox *bb=getBlackboxStuff(at);
8571      if (bb!=NULL)
8572      {
8573        if (!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8574        //else: no op defined, try the default
8575      }
8576      else
8577      return TRUE;
8578    }
8579    else if ((bt>MAX_TOK)&&(op!='('))
8580    {
8581      blackbox *bb=getBlackboxStuff(bt);
8582      if (bb!=NULL)
8583      {
8584        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8585        // else: no op defined
8586      }
8587      else
8588      return TRUE;
8589    }
8590    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8591    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8592  }
8593  a->CleanUp();
8594  b->CleanUp();
8595  return TRUE;
8596}
8597
8598/*==================== operations with 1 arg. ===============================*/
8599/* must be ordered: first operations for chars (infix ops),
8600 * then alphabetically */
8601
8602BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, const struct sValCmd1* dA1, int at, const struct sConvertTypes *dConvertTypes)
8603{
8604  memset(res,0,sizeof(sleftv));
8605  BOOLEAN call_failed=FALSE;
8606
8607  if (!errorreported)
8608  {
8609    BOOLEAN failed=FALSE;
8610    iiOp=op;
8611    int i = 0;
8612    while (dA1[i].cmd==op)
8613    {
8614      if (at==dA1[i].arg)
8615      {
8616        if (currRing!=NULL)
8617        {
8618          if (check_valid(dA1[i].valid_for,op)) break;
8619        }
8620        else
8621        {
8622          if (RingDependend(dA1[i].res))
8623          {
8624            WerrorS("no ring active (5)");
8625            break;
8626          }
8627        }
8628        if (traceit&TRACE_CALL)
8629          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8630        res->rtyp=dA1[i].res;
8631        if ((call_failed=dA1[i].p(res,a)))
8632        {
8633          break;// leave loop, goto error handling
8634        }
8635        if (a->Next()!=NULL)
8636        {
8637          res->next=(leftv)omAllocBin(sleftv_bin);
8638          failed=iiExprArith1(res->next,a->next,op);
8639        }
8640        a->CleanUp();
8641        return failed;
8642      }
8643      i++;
8644    }
8645    // implicite type conversion --------------------------------------------
8646    if (dA1[i].cmd!=op)
8647    {
8648      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8649      i=0;
8650      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8651      while (dA1[i].cmd==op)
8652      {
8653        int ai;
8654        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8655        if ((dA1[i].valid_for & NO_CONVERSION)==0)
8656        {
8657          if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8658          {
8659            if (currRing!=NULL)
8660            {
8661              if (check_valid(dA1[i].valid_for,op)) break;
8662            }
8663            else
8664            {
8665              if (RingDependend(dA1[i].res))
8666              {
8667                WerrorS("no ring active (6)");
8668                break;
8669              }
8670            }
8671            if (traceit&TRACE_CALL)
8672              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8673            res->rtyp=dA1[i].res;
8674            failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8675            || (call_failed=dA1[i].p(res,an)));
8676            // everything done, clean up temp. variables
8677            if (failed)
8678            {
8679              // leave loop, goto error handling
8680              break;
8681            }
8682            else
8683            {
8684              if (an->Next() != NULL)
8685              {
8686                res->next = (leftv)omAllocBin(sleftv_bin);
8687                failed=iiExprArith1(res->next,an->next,op);
8688              }
8689              // everything ok, clean up and return
8690              an->CleanUp();
8691              omFreeBin((ADDRESS)an, sleftv_bin);
8692              return failed;
8693            }
8694          }
8695        }
8696        i++;
8697      }
8698      an->CleanUp();
8699      omFreeBin((ADDRESS)an, sleftv_bin);
8700    }
8701    // error handling
8702    if (!errorreported)
8703    {
8704      if ((at==0) && (a->Fullname()!=sNoName_fe))
8705      {
8706        Werror("`%s` is not defined",a->Fullname());
8707      }
8708      else
8709      {
8710        i=0;
8711        const char *s = iiTwoOps(op);
8712        Werror("%s(`%s`) failed"
8713                ,s,Tok2Cmdname(at));
8714        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8715        {
8716          while (dA1[i].cmd==op)
8717          {
8718            if ((dA1[i].res!=0)
8719            && (dA1[i].p!=jjWRONG))
8720              Werror("expected %s(`%s`)"
8721                ,s,Tok2Cmdname(dA1[i].arg));
8722            i++;
8723          }
8724        }
8725      }
8726    }
8727    res->rtyp = UNKNOWN;
8728  }
8729  a->CleanUp();
8730  return TRUE;
8731}
8732BOOLEAN iiExprArith1(leftv res, leftv a, int op)
8733{
8734  memset(res,0,sizeof(sleftv));
8735
8736  if (!errorreported)
8737  {
8738#ifdef SIQ
8739    if (siq>0)
8740    {
8741      //Print("siq:%d\n",siq);
8742      command d=(command)omAlloc0Bin(sip_command_bin);
8743      memcpy(&d->arg1,a,sizeof(sleftv));
8744      a->Init();
8745      d->op=op;
8746      d->argc=1;
8747      res->data=(char *)d;
8748      res->rtyp=COMMAND;
8749      return FALSE;
8750    }
8751#endif
8752    int at=a->Typ();
8753    // handling bb-objects ----------------------------------------------------
8754    if(op>MAX_TOK) // explicit type conversion to bb
8755    {
8756      blackbox *bb=getBlackboxStuff(op);
8757      if (bb!=NULL)
8758      {
8759        res->rtyp=op;
8760        res->data=bb->blackbox_Init(bb);
8761        if(!bb->blackbox_Assign(res,a)) return FALSE;
8762      }
8763      else
8764      return TRUE;
8765    }
8766    else if (at>MAX_TOK) // argument is of bb-type
8767    {
8768      blackbox *bb=getBlackboxStuff(at);
8769      if (bb!=NULL)
8770      {
8771        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
8772        // else: no op defined
8773      }
8774      else
8775      return TRUE;
8776    }
8777    if (errorreported) return TRUE;
8778
8779    iiOp=op;
8780    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
8781    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
8782  }
8783  a->CleanUp();
8784  return TRUE;
8785}
8786
8787/*=================== operations with 3 args. ============================*/
8788/* must be ordered: first operations for chars (infix ops),
8789 * then alphabetically */
8790
8791static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
8792  const struct sValCmd3* dA3, int at, int bt, int ct,
8793  const struct sConvertTypes *dConvertTypes)
8794{
8795  memset(res,0,sizeof(sleftv));
8796  BOOLEAN call_failed=FALSE;
8797
8798  assume(dA3[0].cmd==op);
8799
8800  if (!errorreported)
8801  {
8802    int i=0;
8803    iiOp=op;
8804    while (dA3[i].cmd==op)
8805    {
8806      if ((at==dA3[i].arg1)
8807      && (bt==dA3[i].arg2)
8808      && (ct==dA3[i].arg3))
8809      {
8810        res->rtyp=dA3[i].res;
8811        if (currRing!=NULL)
8812        {
8813          if (check_valid(dA3[i].valid_for,op)) break;
8814        }
8815        if (traceit&TRACE_CALL)
8816          Print("call %s(%s,%s,%s)\n",
8817            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8818        if ((call_failed=dA3[i].p(res,a,b,c)))
8819        {
8820          break;// leave loop, goto error handling
8821        }
8822        a->CleanUp();
8823        b->CleanUp();
8824        c->CleanUp();
8825        return FALSE;
8826      }
8827      i++;
8828    }
8829    // implicite type conversion ----------------------------------------------
8830    if (dA3[i].cmd!=op)
8831    {
8832      int ai,bi,ci;
8833      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8834      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8835      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8836      BOOLEAN failed=FALSE;
8837      i=0;
8838      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8839      while (dA3[i].cmd==op)
8840      {
8841        if ((dA3[i].valid_for & NO_CONVERSION)==0)
8842        {
8843          if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
8844          {
8845            if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
8846            {
8847              if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
8848              {
8849                res->rtyp=dA3[i].res;
8850                if (currRing!=NULL)
8851                {
8852                  if (check_valid(dA3[i].valid_for,op)) break;
8853                }
8854                if (traceit&TRACE_CALL)
8855                  Print("call %s(%s,%s,%s)\n",
8856                    iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
8857                    Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
8858                failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
8859                  || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
8860                  || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
8861                  || (call_failed=dA3[i].p(res,an,bn,cn)));
8862                // everything done, clean up temp. variables
8863                if (failed)
8864                {
8865                  // leave loop, goto error handling
8866                  break;
8867                }
8868                else
8869                {
8870                  // everything ok, clean up and return
8871                  an->CleanUp();
8872                  bn->CleanUp();
8873                  cn->CleanUp();
8874                  omFreeBin((ADDRESS)an, sleftv_bin);
8875                  omFreeBin((ADDRESS)bn, sleftv_bin);
8876                  omFreeBin((ADDRESS)cn, sleftv_bin);
8877                  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8878                  return FALSE;
8879                }
8880              }
8881            }
8882          }
8883        }
8884        i++;
8885      }
8886      an->CleanUp();
8887      bn->CleanUp();
8888      cn->CleanUp();
8889      omFreeBin((ADDRESS)an, sleftv_bin);
8890      omFreeBin((ADDRESS)bn, sleftv_bin);
8891      omFreeBin((ADDRESS)cn, sleftv_bin);
8892    }
8893    // error handling ---------------------------------------------------
8894    if (!errorreported)
8895    {
8896      const char *s=NULL;
8897      if ((at==0) && (a->Fullname()!=sNoName_fe))
8898      {
8899        s=a->Fullname();
8900      }
8901      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8902      {
8903        s=b->Fullname();
8904      }
8905      else if ((ct==0) && (c->Fullname()!=sNoName_fe))
8906      {
8907        s=c->Fullname();
8908      }
8909      if (s!=NULL)
8910        Werror("`%s` is not defined",s);
8911      else
8912      {
8913        i=0;
8914        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
8915        const char *s = iiTwoOps(op);
8916        Werror("%s(`%s`,`%s`,`%s`) failed"
8917                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8918        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8919        {
8920          while (dA3[i].cmd==op)
8921          {
8922            if(((at==dA3[i].arg1)
8923            ||(bt==dA3[i].arg2)
8924            ||(ct==dA3[i].arg3))
8925            && (dA3[i].res!=0))
8926            {
8927              Werror("expected %s(`%s`,`%s`,`%s`)"
8928                  ,s,Tok2Cmdname(dA3[i].arg1)
8929                  ,Tok2Cmdname(dA3[i].arg2)
8930                  ,Tok2Cmdname(dA3[i].arg3));
8931            }
8932            i++;
8933          }
8934        }
8935      }
8936    }
8937    res->rtyp = UNKNOWN;
8938  }
8939  a->CleanUp();
8940  b->CleanUp();
8941  c->CleanUp();
8942  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8943  return TRUE;
8944}
8945BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8946{
8947  memset(res,0,sizeof(sleftv));
8948
8949  if (!errorreported)
8950  {
8951#ifdef SIQ
8952    if (siq>0)
8953    {
8954      //Print("siq:%d\n",siq);
8955      command d=(command)omAlloc0Bin(sip_command_bin);
8956      memcpy(&d->arg1,a,sizeof(sleftv));
8957      a->Init();
8958      memcpy(&d->arg2,b,sizeof(sleftv));
8959      b->Init();
8960      memcpy(&d->arg3,c,sizeof(sleftv));
8961      c->Init();
8962      d->op=op;
8963      d->argc=3;
8964      res->data=(char *)d;
8965      res->rtyp=COMMAND;
8966      return FALSE;
8967    }
8968#endif
8969    int at=a->Typ();
8970    // handling bb-objects ----------------------------------------------
8971    if (at>MAX_TOK)
8972    {
8973      blackbox *bb=getBlackboxStuff(at);
8974      if (bb!=NULL)
8975      {
8976        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8977        // else: no op defined
8978      }
8979      else
8980      return TRUE;
8981      if (errorreported) return TRUE;
8982    }
8983    int bt=b->Typ();
8984    int ct=c->Typ();
8985
8986    iiOp=op;
8987    int i=0;
8988    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8989    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8990  }
8991  a->CleanUp();
8992  b->CleanUp();
8993  c->CleanUp();
8994  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8995  return TRUE;
8996}
8997BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
8998                                    const struct sValCmd3* dA3,
8999                                    int at,
9000                                    const struct sConvertTypes *dConvertTypes)
9001{
9002  leftv b=a->next;
9003  a->next=NULL;
9004  int bt=b->Typ();
9005  leftv c=b->next;
9006  b->next=NULL;
9007  int ct=c->Typ();
9008  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9009  b->next=c;
9010  a->next=b;
9011  a->CleanUp(); // to cleanup the chain, content already done
9012  return bo;
9013}
9014/*==================== operations with many arg. ===============================*/
9015/* must be ordered: first operations for chars (infix ops),
9016 * then alphabetically */
9017
9018#if 0 // unused
9019static BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
9020{
9021  // cnt = 0: all
9022  // cnt = 1: only first one
9023  leftv next;
9024  BOOLEAN failed = TRUE;
9025  if(v==NULL) return failed;
9026  res->rtyp = LIST_CMD;
9027  if(cnt) v->next = NULL;
9028  next = v->next;             // saving next-pointer
9029  failed = jjLIST_PL(res, v);
9030  v->next = next;             // writeback next-pointer
9031  return failed;
9032}
9033#endif
9034
9035BOOLEAN iiExprArithM(leftv res, leftv a, int op)
9036{
9037  memset(res,0,sizeof(sleftv));
9038
9039  if (!errorreported)
9040  {
9041#ifdef SIQ
9042    if (siq>0)
9043    {
9044      //Print("siq:%d\n",siq);
9045      command d=(command)omAlloc0Bin(sip_command_bin);
9046      d->op=op;
9047      res->data=(char *)d;
9048      if (a!=NULL)
9049      {
9050        d->argc=a->listLength();
9051        // else : d->argc=0;
9052        memcpy(&d->arg1,a,sizeof(sleftv));
9053        switch(d->argc)
9054        {
9055          case 3:
9056            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
9057            a->next->next->Init();
9058            /* no break */
9059          case 2:
9060            memcpy(&d->arg2,a->next,sizeof(sleftv));
9061            a->next->Init();
9062            a->next->next=d->arg2.next;
9063            d->arg2.next=NULL;
9064            /* no break */
9065          case 1:
9066            a->Init();
9067            a->next=d->arg1.next;
9068            d->arg1.next=NULL;
9069        }
9070        if (d->argc>3) a->next=NULL;
9071        a->name=NULL;
9072        a->rtyp=0;
9073        a->data=NULL;
9074        a->e=NULL;
9075        a->attribute=NULL;
9076        a->CleanUp();
9077      }
9078      res->rtyp=COMMAND;
9079      return FALSE;
9080    }
9081#endif
9082    if ((a!=NULL) && (a->Typ()>MAX_TOK))
9083    {
9084      blackbox *bb=getBlackboxStuff(a->Typ());
9085      if (bb!=NULL)
9086      {
9087        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
9088        // else: no op defined
9089      }
9090      else
9091      return TRUE;
9092      if (errorreported) return TRUE;
9093    }
9094    int args=0;
9095    if (a!=NULL) args=a->listLength();
9096
9097    iiOp=op;
9098    int i=0;
9099    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
9100    while (dArithM[i].cmd==op)
9101    {
9102      if ((args==dArithM[i].number_of_args)
9103      || (dArithM[i].number_of_args==-1)
9104      || ((dArithM[i].number_of_args==-2)&&(args>0)))
9105      {
9106        res->rtyp=dArithM[i].res;
9107        if (currRing!=NULL)
9108        {
9109          if (check_valid(dArithM[i].valid_for,op)) break;
9110        }
9111        if (traceit&TRACE_CALL)
9112          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
9113        if (dArithM[i].p(res,a))
9114        {
9115          break;// leave loop, goto error handling
9116        }
9117        if (a!=NULL) a->CleanUp();
9118        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9119        return FALSE;
9120      }
9121      i++;
9122    }
9123    // error handling
9124    if (!errorreported)
9125    {
9126      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName_fe))
9127      {
9128        Werror("`%s` is not defined",a->Fullname());
9129      }
9130      else
9131      {
9132        const char *s = iiTwoOps(op);
9133        Werror("%s(...) failed",s);
9134      }
9135    }
9136    res->rtyp = UNKNOWN;
9137  }
9138  if (a!=NULL) a->CleanUp();
9139        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9140  return TRUE;
9141}
9142
9143/*=================== general utilities ============================*/
9144int IsCmd(const char *n, int & tok)
9145{
9146  int i;
9147  int an=1;
9148  int en=sArithBase.nLastIdentifier;
9149
9150  loop
9151  //for(an=0; an<sArithBase.nCmdUsed; )
9152  {
9153    if(an>=en-1)
9154    {
9155      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9156      {
9157        i=an;
9158        break;
9159      }
9160      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9161      {
9162        i=en;
9163        break;
9164      }
9165      else
9166      {
9167        // -- blackbox extensions:
9168        // return 0;
9169        return blackboxIsCmd(n,tok);
9170      }
9171    }
9172    i=(an+en)/2;
9173    if (*n < *(sArithBase.sCmds[i].name))
9174    {
9175      en=i-1;
9176    }
9177    else if (*n > *(sArithBase.sCmds[i].name))
9178    {
9179      an=i+1;
9180    }
9181    else
9182    {
9183      int v=strcmp(n,sArithBase.sCmds[i].name);
9184      if(v<0)
9185      {
9186        en=i-1;
9187      }
9188      else if(v>0)
9189      {
9190        an=i+1;
9191      }
9192      else /*v==0*/
9193      {
9194        break;
9195      }
9196    }
9197  }
9198  lastreserved=sArithBase.sCmds[i].name;
9199  tok=sArithBase.sCmds[i].tokval;
9200  if(sArithBase.sCmds[i].alias==2)
9201  {
9202    Warn("outdated identifier `%s` used - please change your code",
9203    sArithBase.sCmds[i].name);
9204    sArithBase.sCmds[i].alias=1;
9205  }
9206  #if 0
9207  if (currRingHdl==NULL)
9208  {
9209    #ifdef SIQ
9210    if (siq<=0)
9211    {
9212    #endif
9213      if ((tok>=BEGIN_RING) && (tok<=END_RING))
9214      {
9215        WerrorS("no ring active");
9216        return 0;
9217      }
9218    #ifdef SIQ
9219    }
9220    #endif
9221  }
9222  #endif
9223  if (!expected_parms)
9224  {
9225    switch (tok)
9226    {
9227      case IDEAL_CMD:
9228      case INT_CMD:
9229      case INTVEC_CMD:
9230      case MAP_CMD:
9231      case MATRIX_CMD:
9232      case MODUL_CMD:
9233      case POLY_CMD:
9234      case PROC_CMD:
9235      case RING_CMD:
9236      case STRING_CMD:
9237        cmdtok = tok;
9238        break;
9239    }
9240  }
9241  return sArithBase.sCmds[i].toktype;
9242}
9243static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
9244{
9245  // user defined types are not in the pre-computed table:
9246  if (op>MAX_TOK) return 0;
9247
9248  int a=0;
9249  int e=len;
9250  int p=len/2;
9251  do
9252  {
9253     if (op==dArithTab[p].cmd) return dArithTab[p].start;
9254     if (op<dArithTab[p].cmd) e=p-1;
9255     else   a = p+1;
9256     p=a+(e-a)/2;
9257  }
9258  while ( a <= e);
9259
9260  // catch missing a cmd:
9261  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
9262  // Print("op %d (%c) unknown",op,op);
9263  return 0;
9264}
9265
9266typedef char si_char_2[2];
9267STATIC_VAR si_char_2 Tok2Cmdname_buf=" ";
9268const char * Tok2Cmdname(int tok)
9269{
9270  if (tok <= 0)
9271  {
9272    return sArithBase.sCmds[0].name;
9273  }
9274  if (tok==ANY_TYPE) return "any_type";
9275  if (tok==COMMAND) return "command";
9276  if (tok==NONE) return "nothing";
9277  if (tok < 128)
9278  {
9279    Tok2Cmdname_buf[0]=(char)tok;
9280    return Tok2Cmdname_buf;
9281  }
9282  //if (tok==IFBREAK) return "if_break";
9283  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
9284  //if (tok==ORDER_VECTOR) return "ordering";
9285  //if (tok==REF_VAR) return "ref";
9286  //if (tok==OBJECT) return "object";
9287  //if (tok==PRINT_EXPR) return "print_expr";
9288  if (tok==IDHDL) return "identifier";
9289  if (tok>MAX_TOK) return getBlackboxName(tok);
9290  unsigned i;
9291  for(i=0; i<sArithBase.nCmdUsed; i++)
9292    //while (sArithBase.sCmds[i].tokval!=0)
9293  {
9294    if ((sArithBase.sCmds[i].tokval == tok)&&
9295        (sArithBase.sCmds[i].alias==0))
9296    {
9297      return sArithBase.sCmds[i].name;
9298    }
9299  }
9300  // try gain for alias/old names:
9301  for(i=0; i<sArithBase.nCmdUsed; i++)
9302  {
9303    if (sArithBase.sCmds[i].tokval == tok)
9304    {
9305      return sArithBase.sCmds[i].name;
9306    }
9307  }
9308  return sArithBase.sCmds[0].name;
9309}
9310
9311
9312/*---------------------------------------------------------------------*/
9313/**
9314 * @brief compares to entry of cmdsname-list
9315
9316 @param[in] a
9317 @param[in] b
9318
9319 @return <ReturnValue>
9320**/
9321/*---------------------------------------------------------------------*/
9322static int _gentable_sort_cmds( const void *a, const void *b )
9323{
9324  cmdnames *pCmdL = (cmdnames*)a;
9325  cmdnames *pCmdR = (cmdnames*)b;
9326
9327  if(a==NULL || b==NULL)             return 0;
9328
9329  /* empty entries goes to the end of the list for later reuse */
9330  if(pCmdL->name==NULL) return 1;
9331  if(pCmdR->name==NULL) return -1;
9332
9333  /* $INVALID$ must come first */
9334  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
9335  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
9336
9337  /* tokval=-1 are reserved names at the end */
9338  if (pCmdL->tokval==-1)
9339  {
9340    if (pCmdR->tokval==-1)
9341       return strcmp(pCmdL->name, pCmdR->name);
9342    /* pCmdL->tokval==-1, pCmdL goes at the end */
9343    return 1;
9344  }
9345  /* pCmdR->tokval==-1, pCmdR goes at the end */
9346  if(pCmdR->tokval==-1) return -1;
9347
9348  return strcmp(pCmdL->name, pCmdR->name);
9349}
9350
9351/*---------------------------------------------------------------------*/
9352/**
9353 * @brief initialisation of arithmetic structured data
9354
9355 @retval 0 on success
9356
9357**/
9358/*---------------------------------------------------------------------*/
9359int iiInitArithmetic()
9360{
9361  //printf("iiInitArithmetic()\n");
9362  memset(&sArithBase, 0, sizeof(sArithBase));
9363  iiInitCmdName();
9364  /* fix last-identifier */
9365#if 0
9366  /* we expect that gentable allready did every thing */
9367  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9368      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
9369    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9370  }
9371#endif
9372  //Print("L=%d\n", sArithBase.nLastIdentifier);
9373
9374  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
9375  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
9376
9377  //iiArithAddCmd("Top", 0,-1,0);
9378
9379
9380  //for(i=0; i<sArithBase.nCmdUsed; i++) {
9381  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
9382  //         sArithBase.sCmds[i].name,
9383  //         sArithBase.sCmds[i].alias,
9384  //         sArithBase.sCmds[i].tokval,
9385  //         sArithBase.sCmds[i].toktype);
9386  //}
9387  //iiArithRemoveCmd("Top");
9388  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
9389  //iiArithRemoveCmd("mygcd");
9390  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
9391  return 0;
9392}
9393
9394int iiArithFindCmd(const char *szName)
9395{
9396  int an=0;
9397  int i = 0,v = 0;
9398  int en=sArithBase.nLastIdentifier;
9399
9400  loop
9401  //for(an=0; an<sArithBase.nCmdUsed; )
9402  {
9403    if(an>=en-1)
9404    {
9405      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
9406      {
9407        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
9408        return an;
9409      }
9410      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
9411      {
9412        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
9413        return en;
9414      }
9415      else
9416      {
9417        //Print("RET- 1\n");
9418        return -1;
9419      }
9420    }
9421    i=(an+en)/2;
9422    if (*szName < *(sArithBase.sCmds[i].name))
9423    {
9424      en=i-1;
9425    }
9426    else if (*szName > *(sArithBase.sCmds[i].name))
9427    {
9428      an=i+1;
9429    }
9430    else
9431    {
9432      v=strcmp(szName,sArithBase.sCmds[i].name);
9433      if(v<0)
9434      {
9435        en=i-1;
9436      }
9437      else if(v>0)
9438      {
9439        an=i+1;
9440      }
9441      else /*v==0*/
9442      {
9443        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9444        return i;
9445      }
9446    }
9447  }
9448  //if(i>=0 && i<sArithBase.nCmdUsed)
9449  //  return i;
9450  //PrintS("RET-2\n");
9451  return -2;
9452}
9453
9454char *iiArithGetCmd( int nPos )
9455{
9456  if(nPos<0) return NULL;
9457  if(nPos<(int)sArithBase.nCmdUsed)
9458    return sArithBase.sCmds[nPos].name;
9459  return NULL;
9460}
9461
9462int iiArithRemoveCmd(const char *szName)
9463{
9464  int nIndex;
9465  if(szName==NULL) return -1;
9466
9467  nIndex = iiArithFindCmd(szName);
9468  if(nIndex<0 || nIndex>=(int)sArithBase.nCmdUsed)
9469  {
9470    Print("'%s' not found (%d)\n", szName, nIndex);
9471    return -1;
9472  }
9473  omFree(sArithBase.sCmds[nIndex].name);
9474  sArithBase.sCmds[nIndex].name=NULL;
9475  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9476        (&_gentable_sort_cmds));
9477  sArithBase.nCmdUsed--;
9478
9479  /* fix last-identifier */
9480  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9481      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9482  {
9483    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9484  }
9485  //Print("L=%d\n", sArithBase.nLastIdentifier);
9486  return 0;
9487}
9488
9489int iiArithAddCmd(
9490  const char *szName,
9491  short nAlias,
9492  short nTokval,
9493  short nToktype,
9494  short nPos
9495  )
9496{
9497  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9498  //       nTokval, nToktype, nPos);
9499  if(nPos>=0)
9500  {
9501    // no checks: we rely on a correct generated code in iparith.inc
9502    assume((unsigned)nPos < sArithBase.nCmdAllocated);
9503    assume(szName!=NULL);
9504    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9505    sArithBase.sCmds[nPos].alias   = nAlias;
9506    sArithBase.sCmds[nPos].tokval  = nTokval;
9507    sArithBase.sCmds[nPos].toktype = nToktype;
9508    sArithBase.nCmdUsed++;
9509    //if(nTokval>0) sArithBase.nLastIdentifier++;
9510  }
9511  else
9512  {
9513    if(szName==NULL) return -1;
9514    int nIndex = iiArithFindCmd(szName);
9515    if(nIndex>=0)
9516    {
9517      Print("'%s' already exists at %d\n", szName, nIndex);
9518      return -1;
9519    }
9520
9521    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9522    {
9523      /* needs to create new slots */
9524      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9525      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9526      if(sArithBase.sCmds==NULL) return -1;
9527      sArithBase.nCmdAllocated++;
9528    }
9529    /* still free slots available */
9530    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9531    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9532    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9533    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9534    sArithBase.nCmdUsed++;
9535
9536    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9537          (&_gentable_sort_cmds));
9538    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9539        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9540    {
9541      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9542    }
9543    //Print("L=%d\n", sArithBase.nLastIdentifier);
9544  }
9545  return 0;
9546}
9547
9548static BOOLEAN check_valid(const int p, const int op)
9549{
9550  #ifdef HAVE_PLURAL
9551  if (rIsPluralRing(currRing))
9552  {
9553    if ((p & NC_MASK)==NO_NC)
9554    {
9555      WerrorS("not implemented for non-commutative rings");
9556      return TRUE;
9557    }
9558    else if ((p & NC_MASK)==COMM_PLURAL)
9559    {
9560      Warn("assume commutative subalgebra for cmd `%s` in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9561      return FALSE;
9562    }
9563    /* else, ALLOW_PLURAL */
9564  }
9565  #ifdef HAVE_SHIFTBBA
9566  else if (rIsLPRing(currRing))
9567  {
9568    if ((p & ALLOW_LP)==0)
9569    {
9570      Werror("`%s` not implemented for letterplace rings in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9571      return TRUE;
9572    }
9573  }
9574  #endif
9575  #endif
9576#ifdef HAVE_RINGS
9577  if (rField_is_Ring(currRing))
9578  {
9579    if ((p & RING_MASK)==0 /*NO_RING*/)
9580    {
9581      WerrorS("not implemented for rings with rings as coeffients");
9582      return TRUE;
9583    }
9584    /* else ALLOW_RING */
9585    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9586    &&(!rField_is_Domain(currRing)))
9587    {
9588      WerrorS("domain required as coeffients");
9589      return TRUE;
9590    }
9591    /* else ALLOW_ZERODIVISOR */
9592    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9593    {
9594      WarnS("considering the image in Q[...]");
9595    }
9596  }
9597#endif
9598  return FALSE;
9599}
9600// --------------------------------------------------------------------
9601static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
9602{
9603  if ((currRing!=NULL)
9604  && rField_is_Ring(currRing)
9605  && (!rField_is_Z(currRing)))
9606  {
9607    WerrorS("not implemented for rings with rings as coeffients (except ZZ)");
9608    return TRUE;
9609  }
9610  coeffs cf;
9611  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
9612  int rl=c->nr+1;
9613  int return_type=c->m[0].Typ();
9614  if ((return_type!=IDEAL_CMD)
9615  && (return_type!=MODUL_CMD)
9616  && (return_type!=MATRIX_CMD)
9617  && (return_type!=POLY_CMD))
9618  {
9619    if((return_type==BIGINT_CMD)
9620    ||(return_type==INT_CMD))
9621      return_type=BIGINT_CMD;
9622    else if (return_type==LIST_CMD)
9623    {
9624      // create a tmp list of the correct size
9625      lists res_l=(lists)omAllocBin(slists_bin);
9626      res_l->Init(rl /*c->nr+1*/);
9627      BOOLEAN bo=FALSE;
9628      int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,CHINREM_CMD);
9629      for (unsigned i=0;i<=(unsigned)c->nr;i++)
9630      {
9631        sleftv tmp;
9632        tmp.Copy(v);
9633        bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],CHINREM_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9634        if (bo) { Werror("chinrem failed for list entry %d",i+1); break;}
9635      }
9636      c->Clean();
9637      res->data=res_l;
9638      res->rtyp=LIST_CMD;
9639      return bo;
9640    }
9641    else
9642    {
9643      c->Clean();
9644      WerrorS("poly/ideal/module/matrix/list expected");
9645      return TRUE;
9646    }
9647  }
9648  if (return_type==BIGINT_CMD)
9649    cf=coeffs_BIGINT;
9650  else
9651  {
9652    cf=currRing->cf;
9653    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
9654      cf=cf->extRing->cf;
9655  }
9656  lists pl=NULL;
9657  intvec *p=NULL;
9658  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
9659  else                    p=(intvec*)v->Data();
9660  ideal result;
9661  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
9662  number *xx=NULL;
9663  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
9664  int i;
9665  if (return_type!=BIGINT_CMD)
9666  {
9667    for(i=rl-1;i>=0;i--)
9668    {
9669      if (c->m[i].Typ()!=return_type)
9670      {
9671        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
9672        omFree(x); // delete c
9673        return TRUE;
9674      }
9675      if (return_type==POLY_CMD)
9676      {
9677        x[i]=idInit(1,1);
9678        x[i]->m[0]=(poly)c->m[i].CopyD();
9679      }
9680      else
9681      {
9682        x[i]=(ideal)c->m[i].CopyD();
9683      }
9684      //c->m[i].Init();
9685    }
9686  }
9687  else
9688  {
9689    if (nMap==NULL)
9690    {
9691      Werror("not implemented: map bigint -> %s", nCoeffName(cf));
9692      return TRUE;
9693    }
9694    xx=(number *)omAlloc(rl*sizeof(number));
9695    for(i=rl-1;i>=0;i--)
9696    {
9697      if (c->m[i].Typ()==INT_CMD)
9698      {
9699        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
9700      }
9701      else if (c->m[i].Typ()==BIGINT_CMD)
9702      {
9703        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
9704      }
9705      else
9706      {
9707        Werror("bigint expected at pos %d",i+1);
9708        omFree(x); // delete c
9709        omFree(xx); // delete c
9710        return TRUE;
9711      }
9712    }
9713  }
9714  number *q=(number *)omAlloc(rl*sizeof(number));
9715  if (p!=NULL)
9716  {
9717    for(i=rl-1;i>=0;i--)
9718    {
9719      q[i]=n_Init((*p)[i], cf);
9720    }
9721  }
9722  else
9723  {
9724    for(i=rl-1;i>=0;i--)
9725    {
9726      if (pl->m[i].Typ()==INT_CMD)
9727      {
9728        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
9729      }
9730      else if (pl->m[i].Typ()==BIGINT_CMD)
9731      {
9732        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
9733      }
9734      else
9735      {
9736        Werror("bigint expected at pos %d",i+1);
9737        for(i++;i<rl;i++)
9738        {
9739          n_Delete(&(q[i]),cf);
9740        }
9741        omFree(x); // delete c
9742        omFree(q); // delete pl
9743        if (xx!=NULL) omFree(xx); // delete c
9744        return TRUE;
9745      }
9746    }
9747  }
9748  if (return_type==BIGINT_CMD)
9749  {
9750    CFArray i_v(rl);
9751    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,i_v,coeffs_BIGINT);
9752    res->data=(char *)n;
9753  }
9754  else
9755  {
9756    result=id_ChineseRemainder(x,q,rl,currRing); // deletes also x
9757    c->Clean();
9758    if ((return_type==POLY_CMD) &&(result!=NULL))
9759    {
9760      res->data=(char *)result->m[0];
9761      result->m[0]=NULL;
9762      idDelete(&result);
9763    }
9764    else
9765      res->data=(char *)result;
9766  }
9767  for(i=rl-1;i>=0;i--)
9768  {
9769    n_Delete(&(q[i]),cf);
9770  }
9771  omFree(q);
9772  res->rtyp=return_type;
9773  return result==NULL;
9774}
9775static BOOLEAN jjFAREY_LI(leftv res, leftv u, leftv v)
9776{
9777  lists c=(lists)u->CopyD();
9778  lists res_l=(lists)omAllocBin(slists_bin);
9779  res_l->Init(c->nr+1);
9780  BOOLEAN bo=FALSE;
9781  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,FAREY_CMD);
9782  for (unsigned i=0;i<=(unsigned)c->nr;i++)
9783  {
9784    sleftv tmp;
9785    tmp.Copy(v);
9786    bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],FAREY_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
9787    if (bo) { Werror("farey failed for list entry %d",i+1); break;}
9788  }
9789  c->Clean();
9790  res->data=res_l;
9791  return bo;
9792}
9793// --------------------------------------------------------------------
9794static int jjCOMPARE_ALL(const void * aa, const void * bb)
9795{
9796  leftv a=(leftv)aa;
9797  int at=a->Typ();
9798  leftv b=(leftv)bb;
9799  int bt=b->Typ();
9800  if (at < bt) return -1;
9801  if (at > bt) return 1;
9802  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,'<');
9803  sleftv tmp;
9804  memset(&tmp,0,sizeof(sleftv));
9805  iiOp='<';
9806  BOOLEAN bo=iiExprArith2TabIntern(&tmp,a,'<',b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
9807  if (bo)
9808  {
9809    Werror(" no `<` for %s",Tok2Cmdname(at));
9810    unsigned long ad=(unsigned long)a->Data();
9811    unsigned long bd=(unsigned long)b->Data();
9812    if (ad<bd) return -1;
9813    else if (ad==bd) return 0;
9814    else return 1;
9815  }
9816  else if (tmp.data==NULL) /* not < */
9817  {
9818    iiOp=EQUAL_EQUAL;
9819    tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,EQUAL_EQUAL);
9820    bo=iiExprArith2TabIntern(&tmp,a,EQUAL_EQUAL,b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
9821    if (bo)
9822    {
9823      Werror(" no `==` for %s",Tok2Cmdname(at));
9824      unsigned long ad=(unsigned long)a->Data();
9825      unsigned long bd=(unsigned long)b->Data();
9826      if (ad<bd) return -1;
9827      else if (ad==bd) return 0;
9828      else return 1;
9829    }
9830    else if (tmp.data==NULL) /* not <,== */ return 1;
9831    else return 0;
9832  }
9833  else return -1;
9834}
9835BOOLEAN jjSORTLIST(leftv, leftv arg)
9836{
9837  lists l=(lists)arg->Data();
9838  if (l->nr>0)
9839  {
9840    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
9841  }
9842  return FALSE;
9843}
9844BOOLEAN jjUNIQLIST(leftv, leftv arg)
9845{
9846  lists l=(lists)arg->Data();
9847  if (l->nr>0)
9848  {
9849    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
9850    int i, j, len;
9851    len=l->nr;
9852    i=0;
9853    while(i<len)
9854    {
9855      if(jjCOMPARE_ALL(&(l->m[i]),&(l->m[i+1]))==0)
9856      {
9857        l->m[i].CleanUp();
9858        for(j=i; j<len;j++) l->m[j]=l->m[j+1];
9859        memset(&(l->m[len]),0,sizeof(sleftv));
9860        l->m[len].rtyp=DEF_CMD;
9861        len--;
9862      }
9863      else
9864        i++;
9865    }
9866    //Print("new len:%d\n",len);
9867  }
9868  return FALSE;
9869}
Note: See TracBrowser for help on using the repository browser.