1 #include "kernel/mod2.h" // general settings/macros
2 #include "reporter/reporter.h" // for Print, WerrorS
3 #include "coeffs/numbers.h" // nRegister, coeffs.h
4 #include "coeffs/rmodulon.h" // ZnmInfo
5 #include "coeffs/bigintmat.h" // bigintmat
6 #include "coeffs/longrat.h" // BIGINTs: nlMPZ
7 #include "polys/ext_fields/algext.h" // AlgExtInfo
8 #include "misc/prime.h" // IsPrime
9 #include "Singular/blackbox.h" // blackbox type
10 #include "Singular/ipshell.h" // IsPrime
11 #include "Singular/ipconv.h" // iiConvert etc.
12
13 #include "Singular/ipid.h" // for SModulFunctions, leftv
14
15 #include "Singular/number2.h"
16
crString(coeffs c)17 char *crString(coeffs c)
18 {
19 if (c==NULL)
20 {
21 return omStrDup("oo");
22 }
23 return omStrDup(nCoeffName(c));
24 }
crPrint(coeffs c)25 void crPrint(coeffs c)
26 {
27 char *s=crString(c);
28 PrintS(s);
29 omFree(s);
30 }
31
32 // -----------------------------------------------------------
33 // interpreter stuff for cring/coeffs
34 // -----------------------------------------------------------
jjCRING_Zp(leftv res,leftv a,leftv b)35 BOOLEAN jjCRING_Zp(leftv res, leftv a, leftv b)
36 {
37 coeffs c1=(coeffs)a->Data();
38 long i2=(long)b->Data();
39 if (c1->type==n_Z)
40 {
41 if (i2==IsPrime(i2))
42 {
43 #ifndef TEST_ZN_AS_ZP
44 res->data=(void *)nInitChar(n_Zp,(void*)i2);
45 #else
46 ZnmInfo info;
47 mpz_t modBase;
48 mpz_init_set_ui(modBase,i2);
49 info.base= modBase;
50 info.exp= 1;
51 res->data=(void *)nInitChar(n_Zn,&info);
52 mpz_clear(modBase);
53 #endif
54 }
55 else
56 {
57 ZnmInfo info;
58 mpz_t modBase;
59 mpz_init_set_ui(modBase,i2);
60 info.base= modBase;
61 info.exp= 1;
62 if (mpz_popcount((mpz_ptr)modBase)==1) // is a power of 2
63 {
64 i2=SI_LOG2(i2);
65 // is exponent <=2^(8*sizeof(unsigned long))
66 if (i2<(8*sizeof(unsigned long)))
67 {
68 mpz_clear(modBase);
69 res->data=(void *) nInitChar(n_Z2m,(void*)i2);
70 return FALSE;
71 }
72 else
73 {
74 mpz_set_ui(modBase,2);
75 info.exp=i2;
76 res->data=(void *) nInitChar(n_Znm,&info);
77 mpz_clear(modBase);
78 return FALSE;
79 }
80 }
81 res->data=(void *)nInitChar(n_Zn,&info);
82 mpz_clear(modBase);
83 }
84 return FALSE;
85 }
86 return TRUE;
87 }
jjCRING_Zm(leftv res,leftv a,leftv b)88 BOOLEAN jjCRING_Zm(leftv res, leftv a, leftv b)
89 {
90 coeffs c1=(coeffs)a->Data();
91 number i2=(number)b->Data();
92 if (c1->type==n_Z)
93 {
94 ZnmInfo info;
95 mpz_t modBase;
96 nlMPZ(modBase,i2,coeffs_BIGINT);
97 info.base= (mpz_ptr)modBase;
98 info.exp= 1;
99 if (mpz_popcount(modBase)==1) // is a power of 2
100 {
101 // is exponent <=2^(8*sizeof(unsigned long))
102 mp_bitcnt_t l=mpz_scan1 (modBase,0);
103 if ((l>0) && (l<=8*sizeof(unsigned long)))
104 {
105 res->data=(void *) nInitChar(n_Z2m,(void*)(long)l);
106 }
107 else
108 {
109 mpz_set_ui(modBase,2);
110 info.exp= l;
111 res->data=(void *) nInitChar(n_Znm,&info);
112 }
113 mpz_clear(modBase);
114 return FALSE;
115 }
116 res->data=(void *)nInitChar(n_Zn,&info);
117 mpz_clear(modBase);
118 return FALSE;
119 }
120 return TRUE;
121 }
122
jjEQUAL_CR(leftv res,leftv a,leftv b)123 BOOLEAN jjEQUAL_CR(leftv res, leftv a, leftv b)
124 {
125 coeffs a2=(coeffs)a->Data();
126 coeffs b2=(coeffs)b->Data();
127 res->data=(void*)(long)(a2==b2);
128 if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
129 return FALSE;
130 }
131
jjR2_CR(leftv res,leftv a)132 BOOLEAN jjR2_CR(leftv res, leftv a) // ring ->cring
133 {
134 ring r=(ring)a->Data();
135 AlgExtInfo extParam;
136 extParam.r = r;
137 coeffs cf=nInitChar(n_transExt,&extParam);
138 res->data=(void*)cf;
139 return FALSE;
140 }
141
142 #ifdef SINGULAR_4_2
143 // -----------------------------------------------------------
144 // interpreter stuff for Number/number2
145 // -----------------------------------------------------------
jjNUMBER2_POW(leftv res,leftv a,leftv b)146 BOOLEAN jjNUMBER2_POW(leftv res, leftv a, leftv b)
147 {
148 number2 a2=(number2)a->Data();
149 if (a2->cf==NULL) return TRUE;
150 number2 r=(number2)omAlloc0(sizeof(*r));
151 r->cf=a2->cf;
152 n_Power(a2->n,(int)(long)b->Data(),&(r->n),r->cf);
153 return FALSE;
154 }
jjNUMBER2_OP2(leftv res,leftv a,leftv b)155 BOOLEAN jjNUMBER2_OP2(leftv res, leftv a, leftv b)
156 {
157 int op=iiOp;
158 // binary operations for number2
159 number2 a2=NULL;
160 number aa=NULL;
161 number2 b2=NULL;
162 number bb=NULL;
163 leftv an = (leftv)omAlloc0Bin(sleftv_bin);
164 leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
165 int ai,bi;
166 int at=a->Typ();
167 int bt=b->Typ();
168 if ((ai=iiTestConvert(at,CNUMBER_CMD,dConvertTypes))!=0)
169 {
170 if ((bi=iiTestConvert(bt,CNUMBER_CMD,dConvertTypes))!=0)
171 {
172 iiConvert(at,CNUMBER_CMD,ai,a,an);
173 iiConvert(bt,CNUMBER_CMD,bi,b,bn);
174 a2=(number2)an->Data();
175 b2=(number2)bn->Data();
176 if (((a2!=NULL) && (b2!=NULL) && (a2->cf!=b2->cf))
177 || (a2==NULL)
178 || (b2==NULL))
179 {
180 an->CleanUp();
181 bn->CleanUp();
182 omFreeBin((ADDRESS)an, sleftv_bin);
183 omFreeBin((ADDRESS)bn, sleftv_bin);
184 WerrorS("Number not compatible");
185 return TRUE;
186 }
187 aa=a2->n;
188 bb=b2->n;
189 number2 r=(number2)omAlloc0(sizeof(*r));
190 r->cf=a2->cf;
191 if (r->cf==NULL) op=0; // force error
192 switch(op)
193 {
194 case '+': r->n=n_Add(aa,bb,r->cf);break;
195 case '-': r->n=n_Sub(aa,bb,r->cf);break;
196 case '*': r->n=n_Mult(aa,bb,r->cf);break;
197 case '/': r->n=n_Div(aa,bb,r->cf);break;
198 case '%': r->n=n_IntMod(aa,bb,r->cf);break;
199 default: Werror("unknown binary operation %s(%d)",Tok2Cmdname(op),op);
200 omFree(r);
201 an->CleanUp();
202 bn->CleanUp();
203 omFreeBin((ADDRESS)an, sleftv_bin);
204 omFreeBin((ADDRESS)bn, sleftv_bin);
205 return TRUE;
206 }
207 res->data=(void*)r;
208 r->cf->ref++;
209 return FALSE;
210 }
211 else
212 {
213 an->CleanUp();
214 omFreeBin((ADDRESS)an, sleftv_bin);
215 Werror("cannot convert second operand (%s) to Number",b->Name());
216 return TRUE;
217 }
218 }
219 else
220 {
221 Werror("cannot convert first operand (%s) to Number",a->Name());
222 return TRUE;
223 }
224 }
jjNUMBER2_OP1(leftv res,leftv a)225 BOOLEAN jjNUMBER2_OP1(leftv res, leftv a)
226 {
227 int op=iiOp;
228 // unary operations for number2
229 number2 a2=(number2)a->Data();
230 number2 r=(number2)omAlloc(sizeof(*r));
231 r->cf=a2->cf;
232 if (a2->cf==NULL) op=0; // force error
233 switch(op)
234 {
235 case '-': r->n=n_Copy(a2->n,a2->cf);r->n=n_InpNeg(r->n,a2->cf);break;
236 default: Werror("unknown unary operation %s(%d)",Tok2Cmdname(op),op);
237 omFree(r);
238 return TRUE;
239 }
240 res->data=(void*)r;
241 r->cf->ref++;
242 return FALSE;
243 }
244
jjPOLY2_POW(leftv res,leftv a,leftv b)245 BOOLEAN jjPOLY2_POW(leftv res, leftv a, leftv b)
246 {
247 poly2 a2=(poly2)a->Data();
248 if (a2->cf==NULL) return TRUE;
249 poly2 r=(poly2)omAlloc0(sizeof(*r));
250 r->cf=a2->cf;
251 r->n=p_Power(p_Copy(a2->n,r->cf),(int)(long)b->Data(),r->cf);
252 return FALSE;
253 }
jjPOLY2_OP2(leftv res,leftv a,leftv b)254 BOOLEAN jjPOLY2_OP2(leftv res, leftv a, leftv b)
255 {
256 int op=iiOp;
257 // binary operations for poly2
258 poly2 a2=NULL;
259 poly aa=NULL;
260 poly2 b2=NULL;
261 poly bb=NULL;
262 leftv an = (leftv)omAlloc0Bin(sleftv_bin);
263 leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
264 int ai,bi;
265 int at=a->Typ();
266 int bt=b->Typ();
267 if ((ai=iiTestConvert(at,CPOLY_CMD,dConvertTypes))!=0)
268 {
269 if ((bi=iiTestConvert(bt,CPOLY_CMD,dConvertTypes))!=0)
270 {
271 iiConvert(at,CPOLY_CMD,ai,a,an);
272 iiConvert(bt,CPOLY_CMD,bi,b,bn);
273 a2=(poly2)an->Data();
274 b2=(poly2)bn->Data();
275 if (((a2!=NULL) && (b2!=NULL) && (a2->cf!=b2->cf))
276 || (a2==NULL)
277 || (b2==NULL))
278 {
279 an->CleanUp();
280 bn->CleanUp();
281 omFreeBin((ADDRESS)an, sleftv_bin);
282 omFreeBin((ADDRESS)bn, sleftv_bin);
283 WerrorS("Poly not compatible");
284 return TRUE;
285 }
286 aa=a2->n;
287 bb=b2->n;
288 poly2 r=(poly2)omAlloc0(sizeof(*r));
289 r->cf=a2->cf;
290 if (r->cf==NULL) op=0; // force error
291 switch(op)
292 {
293 case '+': r->n=p_Add_q(p_Copy(aa,r->cf),p_Copy(bb,r->cf),r->cf);break;
294 case '-': r->n=p_Sub(p_Copy(aa,r->cf),p_Copy(bb,r->cf),r->cf);break;
295 case '*': r->n=pp_Mult_qq(aa,bb,r->cf);break;
296 //case '/': r->n=n_Div(aa,bb,r->cf);break;
297 //case '%': r->n=n_IntMod(aa,bb,r->cf);break;
298 default: Werror("unknown binary operation %s(%d)",Tok2Cmdname(op),op);
299 omFree(r);
300 an->CleanUp();
301 bn->CleanUp();
302 omFreeBin((ADDRESS)an, sleftv_bin);
303 omFreeBin((ADDRESS)bn, sleftv_bin);
304 return TRUE;
305 }
306 res->data=(void*)r;
307 r->cf->ref++;
308 return FALSE;
309 }
310 else
311 {
312 an->CleanUp();
313 omFreeBin((ADDRESS)an, sleftv_bin);
314 Werror("cannot convert second operand (%s) to Poly",b->Name());
315 return TRUE;
316 }
317 }
318 else
319 {
320 Werror("cannot convert first operand (%s) to Poly",a->Name());
321 return TRUE;
322 }
323 }
jjPOLY2_OP1(leftv res,leftv a)324 BOOLEAN jjPOLY2_OP1(leftv res, leftv a)
325 {
326 int op=iiOp;
327 // unary operations for poly2
328 poly2 a2=(poly2)a->Data();
329 poly2 r=(poly2)omAlloc(sizeof(*r));
330 r->cf=a2->cf;
331 if (a2->cf==NULL) op=0; // force error
332 switch(op)
333 {
334 case '-': r->n=p_Copy(a2->n,a2->cf);r->n=p_Neg(r->n,a2->cf);break;
335 default: Werror("unknown unary operation %s(%d)",Tok2Cmdname(op),op);
336 omFree(r);
337 return TRUE;
338 }
339 res->data=(void*)r;
340 r->cf->ref++;
341 return FALSE;
342 }
343
jjNUMBER2CR(leftv res,leftv a,leftv b)344 BOOLEAN jjNUMBER2CR(leftv res, leftv a, leftv b)
345 {
346 number2 r=(number2)omAlloc(sizeof(*r));
347 r->cf=(coeffs)b->CopyD();
348 BOOLEAN bo=FALSE;
349 switch(a->Typ())
350 {
351 case INT_CMD:
352 r->n=n_Init((long)a->Data(),r->cf); break;
353 case BIGINT_CMD:
354 {
355 nMapFunc nMap=n_SetMap(coeffs_BIGINT,r->cf);
356 r->n=nMap((number)a->Data(),coeffs_BIGINT,r->cf); break;
357 }
358 case NUMBER_CMD:
359 {
360 nMapFunc nMap=n_SetMap(currRing->cf,r->cf);
361 if (nMap!=NULL)
362 r->n=nMap((number)a->Data(),currRing->cf,r->cf);
363 else
364 bo=TRUE;
365 break;
366 }
367 case CNUMBER_CMD:
368 {
369 number2 a2=(number2)a->Data();
370 if (a2->cf==NULL) bo=TRUE;
371 else
372 {
373 nMapFunc nMap=n_SetMap(a2->cf,r->cf);
374 if (nMap!=NULL)
375 r->n=nMap(a2->n,a2->cf,r->cf);
376 else
377 bo=TRUE;
378 }
379 break;
380 }
381 default: bo=TRUE; break;
382 }
383 if (bo)
384 {
385 Werror("no conversion to Number from %s",Tok2Cmdname(a->Typ()));
386 omFreeSize(r,sizeof(*r));
387 }
388 else
389 res->data=(void*)r;
390 return bo;
391 }
392
jjN2_CR(leftv res,leftv a)393 BOOLEAN jjN2_CR(leftv res, leftv a) // number2 ->cring
394 {
395 number2 n=(number2)a->Data();
396 n->cf->ref++;
397 res->data=(void*)n->cf;
398 return FALSE;
399 }
400
jjP2_R(leftv res,leftv a)401 BOOLEAN jjP2_R(leftv res, leftv a) // poly2 ->ring
402 {
403 poly2 n=(poly2)a->Data();
404 n->cf->ref++;
405 res->data=(void*)n->cf;
406 return FALSE;
407 }
408
jjCM_CR(leftv res,leftv a)409 BOOLEAN jjCM_CR(leftv res, leftv a) // cmatrix ->cring
410 {
411 bigintmat *b=(bigintmat*)a->Data();
412 coeffs cf=b->basecoeffs();
413 if (cf!=NULL)
414 {
415 cf->ref++;
416 }
417 res->data=(void*)cf;
418 return FALSE;
419 }
420
jjCMATRIX_3(leftv res,leftv r,leftv c,leftv cf)421 BOOLEAN jjCMATRIX_3(leftv res, leftv r, leftv c,leftv cf)
422 {
423 bigintmat *b=new bigintmat((int)(long)r->Data(),
424 (int)(long)c->Data(),
425 (coeffs)cf->Data());
426 res->data=(char*)b;
427 return FALSE;
428 }
429
jjN2_N(leftv res,leftv a)430 BOOLEAN jjN2_N(leftv res, leftv a) // number2 ->number
431 {
432 number2 n2=(number2)a->Data();
433 BOOLEAN bo=TRUE;
434 if (currRing!=NULL)
435 {
436 nMapFunc nMap=n_SetMap(n2->cf,currRing->cf);
437 if (nMap!=NULL)
438 {
439 res->data=(void*)nMap(n2->n,n2->cf,currRing->cf);
440 bo=FALSE;
441 }
442 }
443 return bo;
444 }
445
446 // -----------------------------------------------------------
447 // operations with Number/number2
448 // -----------------------------------------------------------
n2Copy(const number2 d)449 number2 n2Copy(const number2 d)
450 {
451 number2 r=NULL;
452 if ((d!=NULL)&&(d->cf!=NULL))
453 {
454 r=(number2)omAlloc(sizeof(*r));
455 d->cf->ref++;
456 r->cf=d->cf;
457 if (d->cf!=NULL)
458 r->n=n_Copy(d->n,d->cf);
459 else
460 r->n=NULL;
461 }
462 return r;
463 }
n2Delete(number2 & d)464 void n2Delete(number2 &d)
465 {
466 if (d!=NULL)
467 {
468 if (d->cf!=NULL)
469 {
470 n_Delete(&d->n,d->cf);
471 nKillChar(d->cf);
472 }
473 omFreeSize(d,sizeof(*d));
474 d=NULL;
475 }
476 }
n2String(number2 d,BOOLEAN typed)477 char *n2String(number2 d, BOOLEAN typed)
478 {
479 StringSetS("");
480 if ((d!=NULL) && (d->cf!=NULL))
481 {
482 if (typed) StringAppendS("Number(");
483 n_Write(d->n,d->cf);
484 if (typed) StringAppendS(")");
485 }
486 else StringAppendS("oo");
487 return StringEndS();
488 }
489
n2Print(number2 d)490 void n2Print(number2 d)
491 {
492 char *s=n2String(d,FALSE);
493 PrintS(s);
494 omFree(s);
495 }
496
497 // -----------------------------------------------------------
498 // operations with Poly/poly2
499 // -----------------------------------------------------------
500
p2Copy(const poly2 d)501 poly2 p2Copy(const poly2 d)
502 {
503 poly2 r=NULL;
504 if ((d!=NULL)&&(d->cf!=NULL))
505 {
506 r=(poly2)omAlloc(sizeof(*r));
507 d->cf->ref++;
508 r->cf=d->cf;
509 if (d->cf!=NULL)
510 r->n=p_Copy(d->n,d->cf);
511 else
512 r->n=NULL;
513 }
514 return r;
515 }
p2Delete(poly2 & d)516 void p2Delete(poly2 &d)
517 {
518 if (d!=NULL)
519 {
520 if (d->cf!=NULL)
521 {
522 p_Delete(&d->n,d->cf);
523 rKill(d->cf);
524 }
525 omFreeSize(d,sizeof(*d));
526 d=NULL;
527 }
528 }
p2String(poly2 d,BOOLEAN typed)529 char *p2String(poly2 d, BOOLEAN typed)
530 {
531 StringSetS("");
532 if ((d!=NULL) && (d->cf!=NULL))
533 {
534 if (typed) StringAppendS("Poly(");
535 p_Write0(d->n,d->cf);
536 if (typed) StringAppendS(")");
537 }
538 else StringAppendS("oo");
539 return StringEndS();
540 }
541
p2Print(poly2 d)542 void p2Print(poly2 d)
543 {
544 char *s=p2String(d,FALSE);
545 PrintS(s);
546 omFree(s);
547 }
548
549 // ---------------------------------------------------------------------
jjBIM2_CR(leftv res,leftv a)550 BOOLEAN jjBIM2_CR(leftv res, leftv a) // bigintmat ->cring
551 {
552 bigintmat *b=(bigintmat*)a->Data();
553 coeffs cf=b->basecoeffs();
554 if (cf==NULL) return TRUE;
555 cf->ref++;
556 res->data=(void*)cf;
557 return FALSE;
558 }
559
560 #endif
561