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