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