source: git/Singular/iparith.cc @ 732205

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