source: git/Singular/number2.cc @ 4698cf8

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