source: git/Singular/mpsr_GetPoly.cc @ 63374c

spielwiese
Last change on this file since 63374c was 63374c, checked in by Olaf Bachmann <obachman@…>, 25 years ago
* moved mpsr_RingEqual to rEqual * controled access to qideal in qrings git-svn-id: file:///usr/local/Singular/svn/trunk@3253 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 26.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/* $Id: mpsr_GetPoly.cc,v 1.22 1999-07-09 14:06:49 obachman Exp $ */
6
7/***************************************************************
8 *
9 * File:       mpsr_GetPoly.cc
10 * Purpose:    rotines which get polys and polynomails (i.e. ring) annotations
11 * Author:     Olaf Bachmann (2/97)
12 *
13 *
14 ***************************************************************/
15#include "mod2.h"
16
17#ifdef HAVE_MPSR
18#include "limits.h"
19
20#include "mpsr_Get.h"
21
22#include "gmp.h"
23#include "mmemory.h"
24#include "tok.h"
25#include "ipid.h"
26#include "longalg.h"
27#include "maps.h"
28#include "ideals.h"
29#include "grammar.h"
30#include "febase.h"
31#include "modulop.h"
32
33#include "mpsr_Tok.h"
34
35#ifdef PARI_BIGINT_TEST
36#include "MP_PariBigInt.h"
37
38MP_Status_t IMP_MyGetApInt(MP_Link_pt link, MP_ApInt_t *apint)
39{
40  GEN pnum;
41  mp_failr(IMP_GetApInt(link, (MP_ApInt_t *) &pnum));
42  _pari_to_gmp(pnum, (mpz_ptr *) apint);
43
44  return MP_Success;
45}
46
47#else
48
49#define IMP_MyGetApInt IMP_GetApInt
50
51#endif
52
53
54/***************************************************************
55 *
56 * global variable definitions
57 *
58 ***************************************************************/
59
60static mpsr_Status_t (*GetCoeff)(MP_Link_pt link, number *x);
61static mpsr_Status_t (*GetAlgNumberNumber)(MP_Link_pt link, number *x);
62static MP_Sint32_t gNalgvars = 0;
63static MP_Sint32_t gNvars = 0;
64static ring        currGetRing = NULL;
65
66
67/***************************************************************
68 *
69 * prototype declarations
70 *
71 ***************************************************************/
72static void        SetGetFuncs(ring r);
73static mpsr_Status_t GetModuloNumber(MP_Link_pt link, number *a);
74static mpsr_Status_t GetGaloisNumber(MP_Link_pt link, number *a);
75static mpsr_Status_t GetFloatNumber(MP_Link_pt link, number *a);
76static mpsr_Status_t GetApInt(MP_Link_pt link, mpz_ptr ap);
77static mpsr_Status_t GetRationalNumber(MP_Link_pt link, number *a);
78static mpsr_Status_t GetAlgNumber(MP_Link_pt link, number *a);
79static mpsr_Status_t GetVarNumberAnnot(MPT_Node_pt node, ring r, BOOLEAN mv);
80static mpsr_Status_t GetProtoTypeAnnot(MPT_Node_pt node, ring r, BOOLEAN mv,
81                                     ring &subring);
82static mpsr_Status_t GetOrderingAnnot(MPT_Node_pt node, ring r, BOOLEAN mv,
83                                      BOOLEAN &IsUnOrdered);
84static mpsr_Status_t GetSimpleOrdering(MPT_Node_pt node, ring r, short i);
85static mpsr_Status_t GetVarNamesAnnot(MPT_Node_pt node, ring r);
86static mpsr_Status_t GetDefRelsAnnot(MPT_Node_pt node, ring r);
87
88/***************************************************************
89 *
90 * Setting the global Put Functions
91 *
92 ***************************************************************/
93
94static inline BOOLEAN IsCurrGetRing(ring r)
95{
96  if (r == currGetRing && r == currRing) return 1;
97  else return 0;
98}
99
100static void SetGetFuncs(ring r)
101{
102  currGetRing = r;
103  // first, we set the PutNumber function
104  gNvars = r->N;
105  mpsr_InitTempArray(gNvars + 1);
106
107  if (rField_is_Q(r))
108    // rational numbers
109    GetCoeff = GetRationalNumber;
110  else if (rField_is_Zp(r))
111    GetCoeff = GetModuloNumber;
112  else if (rField_is_GF(r))
113      GetCoeff = GetGaloisNumber;
114  else if (rField_is_R(r))
115    GetCoeff = GetFloatNumber;
116  else
117  {
118    // now we come to algebraic numbers
119    gNalgvars = rPar(r);
120    mpsr_InitTempArray(gNalgvars);
121    GetCoeff = GetAlgNumber;
122    if (rField_is_Zp_a(r))
123      // first, Z/p(a)
124      GetAlgNumberNumber = GetModuloNumber;
125    else
126      GetAlgNumberNumber = GetRationalNumber;
127  }
128 
129  // still need to set the global ring
130  mpsr_SetCurrRing(r, TRUE);
131}
132
133
134
135/***************************************************************
136 *
137 * Routines for Getting coeffs
138 *
139 ***************************************************************/
140// we always Get modulo numbers without a node, since
141// we have type-spec this before
142static mpsr_Status_t GetModuloNumber(MP_Link_pt link, number *a)
143{
144  MP_Uint32_t x;
145  mp_failr(IMP_GetUint32(link, &x));
146  *a=npInit((int)x);
147  return mpsr_Success;
148}
149
150static mpsr_Status_t GetGaloisNumber(MP_Link_pt link, number *a)
151{
152  mp_return(IMP_GetUint32(link, (MP_Uint32_t *) a));
153}
154
155static mpsr_Status_t GetFloatNumber(MP_Link_pt link, number *a)
156{
157   mp_return( IMP_GetReal32(link , (MP_Real32_t *) a));
158}
159
160static mpsr_Status_t GetApInt(MP_Link_pt link, mpz_ptr ap)
161{
162  MP_NodeType_t     node;
163  MP_DictTag_t      dict;
164  MP_NumChild_t     num_child;
165  MP_NumAnnot_t     num_annots;
166  MP_Common_t       cvalue;
167  MP_Boolean_t      req = 0;
168 
169  mp_failr(IMP_GetNodeHeader(link,&node,&dict, &cvalue, &num_annots,
170                             &num_child));
171
172  if (node == MP_ApIntType)
173  {
174    mpz_init(ap);
175    mp_failr(IMP_MyGetApInt(link, (MP_ApInt_t *) &ap));
176  }
177  else if (node == MP_Sint32Type || node == MP_Sint8Type)
178  {
179    MP_Sint32_t i;
180    if (node == MP_Sint8Type)
181      i = (int) ((signed char) cvalue);
182    else
183      mp_failr(IMP_GetSint32(link, &i));
184    mpz_init_set_si((mpz_ptr) ap, i);
185  }
186  else if (node == MP_Uint32Type || node == MP_Uint8Type)
187  {
188    MP_Uint32_t i;
189    if (node == MP_Uint8Type)
190      i = cvalue;
191    else
192      mp_failr(IMP_GetUint32(link, &i));
193    mpz_init_set_ui((mpz_ptr) ap, i);
194  }
195  else
196    return mpsr_SetError(mpsr_WrongNodeType);
197 
198  if (num_annots > 0)
199  {
200    mpt_failr(MPT_SkipAnnots(link, num_annots, &req));
201    if (req) return mpsr_SetError(mpsr_ReqAnnotSkip);
202  }
203 
204  return mpsr_Success;
205}
206   
207// This supposes that number is of char 0, i.e. a rational number
208static mpsr_Status_t GetRationalNumber(MP_Link_pt link, number *x)
209{
210  MP_NodeType_t     node;
211  MP_DictTag_t      dict;
212  MP_NumChild_t     num_child;
213  MP_NumAnnot_t     num_annots;
214  MP_Sint32_t       i;
215  MP_Common_t       cvalue;
216  number            y;
217  MP_Boolean_t      req;
218
219  mp_failr(IMP_GetNodeHeader(link,&node,&dict, &cvalue, &num_annots,
220                             &num_child));
221
222  // start with the most frequent cases
223  if (node == MP_Sint32Type) 
224  {
225    mp_failr(IMP_GetSint32(link, &i));
226    *x = nlInit(i);
227  }
228  else if (node == MP_ApIntType)
229  {
230    mpz_ptr gnum;
231    y =  (number) Alloc0(sizeof(rnumber));
232#ifdef LDEBUG
233    y->debug = 123456;
234#endif
235    y->s = 3;
236    gnum = &(y->z);
237    mpz_init(gnum);
238    mp_failr(IMP_MyGetApInt(link, (MP_ApInt_t *) &gnum));
239    *x = nlInit(y);
240  }
241  // fraction of numbers
242  else if (node == MP_CommonOperatorType &&
243           dict== MP_BasicDict &&
244           cvalue == MP_CopBasicDiv)
245  {
246    if (num_annots > 0)
247    {
248      mpt_failr(MPT_SkipAnnots(link, num_annots, &req));
249      if (req) return mpsr_SetError(mpsr_ReqAnnotSkip);
250    }
251    *x =  (number) Alloc0(sizeof(rnumber));
252    y = (number) *x;
253#ifdef LDEBUG
254    y->debug = 123456;
255#endif
256    y->s = 1;
257    failr(GetApInt(link, &(y->z)));
258    return GetApInt(link, &(y->n));
259  }
260  // check for some more esoteric cases
261  else if (node == MP_Uint8Type)
262    *x = nlInit(cvalue);
263  else if (node == MP_Sint8Type)
264    // be careful -- need to handle the value "-2", for example
265    *x = nlInit((int) ((MP_Sint8_t) cvalue));
266  else if (node == MP_Uint32Type)
267  {
268    MP_Uint32_t ui;
269    mp_failr(IMP_GetUint32(link, &ui));
270    // check whether u_int can be casted safely to int
271    if (ui < INT_MAX)
272      *x = nlInit(i);
273    else
274    {
275      // otherwise, make an apint out of it
276      *x =  (number) Alloc0(sizeof(rnumber));
277      y = (number) *x;
278#ifdef LDEBUG
279      y->debug = 123456;
280#endif
281      mpz_init_set_ui(&(y->z), ui);
282      y->s = 3;
283    }
284  }
285  else
286    return mpsr_SetError(mpsr_WrongNodeType);
287 
288  if (num_annots > 0)
289  {
290    mpt_failr(MPT_SkipAnnots(link, num_annots, &req));
291    if (req) return mpsr_SetError(mpsr_ReqAnnotSkip);
292  }
293
294  return mpsr_Success;
295}
296
297/***************************************************************
298 *
299 * Algebraic Numbers (a la Singular)
300 *
301 ***************************************************************/
302static inline mpsr_Status_t GetAlgPoly(MP_Link_pt link, alg *p)
303{
304  MP_Uint32_t j, nm;
305  int *exp, i;
306  alg a;
307
308  IMP_GetUint32(link, &nm);
309
310  if (nm == 0)
311  {
312    *p = NULL;
313    return mpsr_Success;
314  }
315  a = napNew();
316  *p = a;
317
318  failr(GetAlgNumberNumber(link, &(a->ko)));
319#if SIZEOF_INT == SIZEOF_PARAMETER
320  exp = &(a->e[0]);
321  mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &exp, naNumbOfPar));
322#else
323  mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &gTa, naNumbOfPar));
324  for (i=0; i<naNumbOfPar; i++)
325    a->e[i] = (PARAMETER_TYPE) gTa[i];
326#endif 
327
328  for (j=1; j<nm; j++)
329  {
330    a->ne = napNew();
331    a = a->ne;
332    failr(GetAlgNumberNumber(link, &(a->ko)));
333#if SIZEOF_INT == SIZEOF_PARAMETER
334    exp = &(a->e[0]);
335    mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &exp, naNumbOfPar));
336#else
337  mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &gTa, naNumbOfPar));
338  for (i=0; i<naNumbOfPar; i++)
339    a->e[i] = (PARAMETER_TYPE) gTa[i];
340#endif 
341  }
342  a->ne = NULL;
343
344  return mpsr_Success;
345}
346
347static mpsr_Status_t GetAlgNumber(MP_Link_pt link, number *a)
348{
349  lnumber b;
350  MP_Uint32_t ut;
351
352  // Get the union tag
353  mp_failr(IMP_GetUint32(link, &ut));
354  if (ut == 0)
355  {
356    *a = NULL;
357    return mpsr_Success;
358  }
359  else if (ut == 1 || ut == 2)
360  {
361    // single number
362    b = (lnumber) Alloc0(sizeof(rnumber));
363    *a = (number) b;
364    failr(GetAlgPoly(link, &(b->z)));
365    if (ut == 2)
366      return GetAlgPoly(link, &(b->n));
367    else
368      return mpsr_Success;
369  }
370  else
371    return mpsr_SetError(mpsr_WrongUnionDiscriminator);
372}
373
374/***************************************************************
375 *
376 *  Getting polys
377 *
378 ***************************************************************/
379mpsr_Status_t mpsr_GetPoly(MP_Link_pt link, poly &p, MP_Uint32_t nmon,
380                         ring cring)
381{
382  poly pp;
383  MP_Sint32_t i;
384  MP_Uint32_t j;
385
386  if (! IsCurrGetRing(cring))
387    SetGetFuncs(cring);
388 
389  if (nmon == 0)
390  {
391    p = NULL;
392    return mpsr_Success;
393  }
394 
395  pp = pInit();
396  p = pp;
397  failr(GetCoeff(link, &(pp->coef)));
398  if (gNvars > 1)
399  {
400    MP_Sint32_t* Ta = &gTa[1];
401    mp_failr(IMP_GetSint32Vector(link, &Ta, gNvars));
402    for (i=1; i<=gNvars; i++)
403      pSetExp(pp,i , (Exponent_t) gTa[i]);
404    pSetm(pp);
405
406    for (j=1; j<nmon; j++)
407    {
408      pp->next = pInit();
409      pp = pp->next;
410      failr(GetCoeff(link, &(pp->coef)));
411      mp_failr(IMP_GetSint32Vector(link, &Ta, gNvars));
412      for (i=1; i<=gNvars; i++)
413        pSetExp(pp, i, (Exponent_t) gTa[i]);
414      pSetm(pp);
415    }
416  }
417  else
418  {
419    mp_failr(IMP_GetSint32(link, &i));
420    pSetExp(pp,1, (Exponent_t) i);
421    pSetm(pp);
422   
423    for (j=1; j<nmon; j++)
424    {
425      pp->next = pInit();
426      pp = pp->next;
427      failr(GetCoeff(link, &(pp->coef)));
428      mp_failr(IMP_GetSint32(link, &i));
429      pSetExp(pp,1, (Exponent_t) i);
430      pSetm(pp);
431    }
432  }
433
434  pp->next = NULL;
435
436  return mpsr_Success;
437}
438
439mpsr_Status_t mpsr_GetPolyVector(MP_Link_pt link, poly &p, MP_Uint32_t nmon,
440                          ring cring)
441{
442  poly pp;
443  MP_Sint32_t i, n1;
444  MP_Uint32_t j;
445
446  if (!IsCurrGetRing(cring))
447    SetGetFuncs(cring);
448 
449  n1 = gNvars + 1;
450  if (nmon == 0)
451  {
452    p = NULL;
453    return mpsr_Success;
454  }
455 
456  pp = pInit();
457  p = pp;
458  failr(GetCoeff(link, &(pp->coef)));
459  if (gNvars > 1)
460  {
461    mp_failr(IMP_GetSint32Vector(link, &gTa, n1));
462    pGetComp(pp) = gTa[0];
463    for (i=1; i<n1; i++)
464      pSetExp(pp, i, (Exponent_t) gTa[i]);
465    pSetm(pp);
466
467    for (j=1; j<nmon; j++)
468    {
469      pp->next = pInit();
470      pp = pp->next;
471      failr(GetCoeff(link, &(pp->coef)));
472      mp_failr(IMP_GetSint32Vector(link, &gTa, n1));
473      pGetComp(pp) =  gTa[0];
474      for (i=1; i<n1; i++)
475        pSetExp(pp,i, (Exponent_t) gTa[i]);
476      pSetm(pp);
477    }
478  }
479  else
480  {
481    mp_failr(IMP_GetSint32(link, &i));
482    pGetComp(pp) = (Exponent_t) i;
483    mp_failr(IMP_GetSint32(link, &i));
484    pSetExp(pp,1, (Exponent_t) i);
485    pSetm(pp);
486   
487    for (j=1; j<nmon; j++)
488    {
489      pp->next = pInit();
490      pp = pp->next;
491      failr(GetCoeff(link, &(pp->coef)));
492      mp_failr(IMP_GetSint32(link, &i));
493      pGetComp(pp) = (Exponent_t) i;
494      mp_failr(IMP_GetSint32(link, &i));
495      pSetExp(pp,1, (Exponent_t) i);
496      pSetm(pp);
497    }
498  }
499  pp->next = NULL;
500
501  return mpsr_Success;
502}
503
504/***************************************************************
505 *
506 *  The Getting annotation buisness
507 *
508 ***************************************************************/
509#define falser(x)                               \
510do                                              \
511{                                               \
512  if (!(x)) return mpsr_Failure;                   \
513}                                               \
514while (0)
515
516// We assume that the node is that of a DDP: This returns
517// MP_Succcess, if annots of node can be used to construct a
518// Singular ring (in which case r is the respective ring) or,
519// MP_Failure, if not
520mpsr_Status_t mpsr_GetRingAnnots(MPT_Node_pt node, ring &r, 
521                                 BOOLEAN &mv, BOOLEAN &IsUnOrdered)
522{
523  sip_sring r1, *subring;
524  poly minpoly = NULL;
525
526  memset(&r1, 0, sizeof(sip_sring));
527
528  r = NULL;
529  if (MPT_Annot(node, MP_PolyDict, MP_AnnotPolyModuleVector) != NULL)
530    mv = 1;
531  else
532    mv = 0;
533
534  // sets r->N
535  if (GetVarNumberAnnot(node, &r1, mv) != mpsr_Success)
536    Warn("GetVarNumberAnnot: using the one found in the prototype");
537
538  // sets r->char and r->minpoly, r->parameter; if necessary
539  failr(GetProtoTypeAnnot(node, &r1, mv, subring));
540
541  // if we are still here, then we are successful in constructing the ring
542  r = (ring) Alloc(sizeof(sip_sring));
543  memcpy(r, &r1, sizeof(sip_sring));
544
545  if (GetVarNamesAnnot(node, r) != mpsr_Success)
546    Warn("GetVarNamesAnnot: using default variable names");
547
548  if (GetOrderingAnnot(node,r, mv, IsUnOrdered) != mpsr_Success)
549    Warn("GetOrderingAnnot: using unspec ordering");
550
551  rComplete(r);
552
553  if (GetDefRelsAnnot(node, r) != mpsr_Success)
554    Warn("GetDefRelsAnnot: using no defining relations");
555
556  // check on whether or not I have to set a minpoly
557  if (subring != NULL)
558  {
559    if ((subring->qideal != NULL) &&
560        ((minpoly = subring->qideal->m[0]) != NULL))
561    {
562      mpsr_SetCurrRing(r, TRUE);
563      minpoly = maIMap(subring, minpoly);
564      r->minpoly = minpoly->coef;
565      pFree1(minpoly);
566    }
567    rKill(subring);
568  }
569
570  // complete ring constructions
571  return mpsr_Success;
572}
573
574
575static mpsr_Status_t GetVarNumberAnnot(MPT_Node_pt node, ring r, BOOLEAN mv)
576{
577  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyVarNumber);
578
579  if (annot != NULL) 
580  {
581    if (annot->value != NULL && annot->value->node->type == MP_Uint32Type)
582    {
583      // Hm.. should check that r->N is not too big for Singular
584      r->N = (short) MP_UINT32_T(annot->value->node->nvalue);
585      if (mv) (r->N)--;
586      return mpsr_Success;
587    }
588  }
589  return mpsr_Failure;
590}
591
592         
593static mpsr_Status_t GetProtoTypeAnnot(MPT_Node_pt node, ring r, BOOLEAN mv,
594                                       ring &subring)
595{
596  MPT_Annot_pt annot = NULL;
597  MPT_Tree_pt  val;
598  MPT_Tree_pt  *ta;
599
600  subring = NULL;
601 
602  // look for prototype annot
603  if ((val = MPT_ProtoAnnotValue(node)) == NULL)
604    return mpsr_Failure;
605
606  // check value of annot
607  node = val->node;
608  if (! (NodeCheck(node, MP_CommonOperatorType, MP_ProtoDict,
609                   MP_CopProtoStruct) && node->numchild == 2))
610    return mpsr_Failure;
611  // get the two args of the value
612  ta = (MPT_Tree_pt *) val->args;
613
614
615  // We get the exponent vector specification first
616  node = ta[1]->node;
617  if (! (NodeCheck(node, MP_CommonMetaOperatorType, MP_ProtoDict,
618                   MP_CopProtoArray) && node->numchild > 0))
619    return mpsr_Failure;
620  // check r->N and reset, if necessary
621  if (mv) 
622  {
623    if (r->N != (int) (node->numchild - 1))
624    {
625      Warn("GetProtoAnnot: Inconsistent NumVars specification");
626      r->N = (node->numchild -1);
627    }
628  }
629  else
630  {
631    if (r->N != (int) node->numchild)
632    {
633      Warn("GetProtoAnnot: Inconsistent NumVars specification");
634      r->N = (node->numchild);
635    }
636  }
637  // check for type of exponent
638  if ((val = MPT_ProtoAnnotValue(node)) == NULL)
639    return mpsr_Failure;
640 
641  node = val->node;
642  falser(NodeCheck(node, MP_CommonMetaType, MP_ProtoDict, MP_CmtProtoIMP_Sint32));
643
644  // consider the first arg -- which specify the coeffs
645  val = ta[0];
646  node = val->node;
647  if (node->type == MP_CommonMetaType)
648  {
649    // char 0
650    if (MP_COMMON_T(node->nvalue) == MP_CmtNumberRational &&
651        node->dict == MP_NumberDict)
652    {
653      r->ch = 0;
654      // Hmm ... we should check for the normalized annot
655    }
656    else if (MP_COMMON_T(node->nvalue) == MP_CmtProtoIMP_Uint32 &&
657             node->dict == MP_ProtoDict &&
658             (annot = MPT_Annot(node,MP_NumberDict,MP_AnnotNumberModulos))
659              != NULL)
660    {
661      // char p || GF(p,n)
662      falser(annot->value != NULL &&
663             annot->value->node->type == MP_Uint32Type);
664      r->ch = MP_UINT32_T(annot->value->node->nvalue);
665
666      if (MPT_Annot(annot->value->node,
667                        MP_NumberDict, MP_AnnotNumberIsPrime) == NULL)
668      {
669        // GF(p,n)
670        falser((annot = MPT_Annot(annot->value->node, 129,
671                                  MP_AnnotSingularGalois)) != NULL &&
672           (annot->value != NULL) &&
673           (annot->value->node->type == MP_StringType));
674        r->parameter = (char **)Alloc(sizeof(char *));
675        r->parameter[0] = mstrdup(MP_STRING_T(annot->value->node->nvalue));
676        r->P = 1;
677      }
678    }
679    else if (MP_COMMON_T(node->nvalue) == MP_CmtProtoIMP_Real32 &&
680             node->dict == MP_ProtoDict)
681    {
682      // floats
683      r->ch = -1;
684    }
685    else
686      return mpsr_SetError(mpsr_UnknownCoeffDomain);
687   
688    return mpsr_Success;
689  }
690  else
691  {
692    // alg numbers
693    BOOLEAN mv2, IsUnOrdered;
694    int i;
695
696    // DDP Frac Node check
697    falser(NodeCheck(node, MP_CommonMetaOperatorType, MP_BasicDict,
698                    MP_CopBasicDiv) &&
699           node->numchild == 0);
700    falser((val = MPT_ProtoAnnotValue(node)) != NULL);
701    node = val->node;
702    mpsr_assume(node != NULL);
703    falser(NodeCheck(node, MP_CommonMetaOperatorType, MP_PolyDict,
704                     MP_CopPolyDenseDistPoly) &&
705           node->numchild == 0);
706    // GetRingAnnots
707    failr(mpsr_GetRingAnnots(node, subring, mv2, IsUnOrdered));
708    // Check whether the ring can be "coerced" to an algebraic number
709    falser( (rField_is_Zp(subring)||rField_is_Q(subring)) && 
710           // orig: subring->ch >= 0 &&a ???
711           subring->order[0] == ringorder_lp &&
712           subring->order[2] == 0 &&
713           mv2 == FALSE &&
714           IsUnOrdered == FALSE);
715
716    // Now do the coercion
717    r->ch = (rField_is_Q(subring) ? 1 : - rChar(subring));
718    r->parameter = (char **) Alloc((subring->N)*sizeof(char*));
719    r->P = subring->N;
720    for (i=0; i < subring->N; i++)
721      r->parameter[i] = mstrdup(subring->names[i]);
722   
723    // everything is ok
724    return mpsr_Success;
725  }
726}
727
728static mpsr_Status_t GetVarNamesAnnot(MPT_Node_pt node, ring r)
729{
730  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyVarNames);
731  short num_vars = 0, N, lb, offset, nc;
732
733  mpsr_assume(r != NULL);
734  N = r->N;
735  r->names = (char **) Alloc(N * sizeof(char *));
736 
737  // fill in varnames from the back
738  if (annot != NULL && annot->value != NULL)
739  {
740    node = annot->value->node;
741    nc = (short) node->numchild;
742    if (NodeCheck(node, MP_CommonOperatorType, MP_ProtoDict, MP_CopProtoArray))
743    {
744      MPT_Tree_pt val = MPT_ProtoAnnotValue(node);
745      if (val != NULL &&
746          NodeCheck(val->node, MP_CommonMetaType, MP_ProtoDict,
747                    MP_CmtProtoIMP_Identifier))
748      {
749        MPT_Arg_pt arg_pt = annot->value->args;       
750        lb = min(nc, N);
751        offset = N - (short) nc;
752        if (offset < 0) offset = 0;
753        for (; num_vars < lb; num_vars++)
754          r->names[offset + num_vars] =
755            mstrdup(MP_STRING_T(arg_pt[num_vars]));
756      }
757    }
758    else if (node->type == MP_IdentifierType)
759    {
760      r->names[N-1] = mstrdup(MP_STRING_T(annot->value->node->nvalue));
761      num_vars = 1;
762    }
763  }
764
765  // fill in all remaining varnames
766  if (num_vars < N)
767  {
768    char vn[10];
769    offset = N - num_vars;
770    for (nc = 0; nc < offset; nc++)
771    {
772      sprintf(vn, "x(%d)", nc);
773      r->names[nc] = mstrdup(vn);
774    }
775  }
776
777  if (num_vars < N) return mpsr_Failure;
778  else return mpsr_Success;
779}
780
781static mpsr_Status_t GetOrderingAnnot(MPT_Node_pt node, ring r, 
782                                      BOOLEAN mv, BOOLEAN &IsUnOrdered)
783{
784  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, 
785                                 MP_AnnotShouldHavePolyOrdering); 
786  IsUnOrdered = FALSE;
787  mpsr_Status_t status = mpsr_Success;
788  if (annot == NULL)
789  {
790    annot = MPT_Annot(node, MP_PolyDict,MP_AnnotPolyOrdering);
791    if (annot == NULL) status = mpsr_Failure;
792  }
793  else
794  {
795    IsUnOrdered = TRUE;
796  }
797
798
799  if (status == mpsr_Success) node =  annot->value->node;
800
801  // Check for BlockOrdering
802  if (status == mpsr_Success &&
803      NodeCheck(annot->value->node, MP_CommonOperatorType,
804               MP_BasicDict, MP_CopBasicList))
805  {
806    MP_NumChild_t nc = node->numchild, i;
807    MPT_Tree_pt *tarray = (MPT_Tree_pt *) annot->value->args, *tarray2, tree;
808
809    if (! mv) nc += 2; else nc++;
810    r->block0 = (int *) Alloc0(nc*sizeof(int *));
811    r->block1 = (int *) Alloc0(nc*sizeof(int *));
812    r->wvhdl  = (short **) Alloc0(nc*sizeof(short *));
813    r->order  = (int *) Alloc0(nc*sizeof(int *));
814
815    if (! mv)
816    {
817      r->order[nc-2] = ringorder_C;
818      nc = nc - 2;
819    }
820    else
821      nc--;
822
823    for (i=0; i<nc; i++)
824    {
825      tree = tarray[i];
826      if (NodeCheck(tree->node, MP_CommonOperatorType,
827                   MP_BasicDict, MP_CopBasicList) &&
828          tree->node->numchild == 3)
829      {
830        tarray2 = (MPT_Tree_pt *) tree->args;
831        if (GetSimpleOrdering(tarray2[0]->node, r, i) != mpsr_Success ||
832            tarray2[1]->node->type != MP_Uint32Type ||
833            tarray2[2]->node->type != MP_Uint32Type)
834        {
835          status = mpsr_Failure;
836          break;
837        }
838        else
839        {
840          r->block0[i] = MP_SINT32_T(tarray2[1]->node->nvalue);
841          r->block1[i] = MP_SINT32_T(tarray2[2]->node->nvalue);
842        }
843      }
844      else
845      {
846          status = mpsr_Failure;
847          break;
848      }
849    }
850
851    if (status == mpsr_Success) status = mpsr_rSetOrdSgn(r);
852   
853    // Clean up if sth went wrong
854    if (status == mpsr_Failure)
855    {
856      if (mv) nc++;
857      else nc += 2;
858      Free(r->block0, nc*sizeof(int *));
859      Free(r->block1, nc*sizeof(int *));
860      Free(r->order, nc*sizeof(int *));
861      Free(r->wvhdl, nc*sizeof(short *));
862    }
863    else
864      return mpsr_Success;
865  }
866
867  // Either Simple Ordering, or sth failed from before
868  r->wvhdl = (short **)Alloc0(3 * sizeof(short *));
869  r->order = (int *) Alloc0(3 * sizeof(int *));
870  r->block0 = (int *)Alloc0(3 * sizeof(int *));
871  r->block1 = (int *)Alloc0(3 * sizeof(int *));
872  r->order[1] = ringorder_C;
873  r->block0[0] = 1;
874  r->block1[0] = r->N;
875
876  // Check for simple Ordering
877  if (status == mpsr_Success)
878    status = GetSimpleOrdering(node, r, 0);
879
880  if (status != mpsr_Success)
881  {
882    r->order[0] = ringorder_unspec;
883    IsUnOrdered = FALSE;
884  }
885 
886  return mpsr_rSetOrdSgn(r);
887}
888
889static mpsr_Status_t GetSimpleOrdering(MPT_Node_pt node, ring r, short i)
890{
891  if (node->type != MP_CommonConstantType)
892    return mpsr_Failure;
893
894  int sr_ord =  mpsr_mp2ord(MP_COMMON_T(node->nvalue));
895 
896  r->order[i] = sr_ord;
897  if (r->order[i] == ringorder_unspec) return mpsr_Failure;
898
899  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyWeights);
900
901  if (annot == NULL) return mpsr_Success;
902  if (annot->value == NULL) return mpsr_Failure;
903
904  node = annot->value->node;
905  if (r->order[i] == ringorder_M)
906  {
907    if (! NodeCheck(node, MP_CommonOperatorType, MP_MatrixDict,
908                   MP_CopMatrixDenseMatrix))
909      return mpsr_Failure;
910  }
911  else
912  {
913    if (! NodeCheck(node, MP_CommonOperatorType, MP_MatrixDict,
914                    MP_CopMatrixDenseVector))
915      return mpsr_Failure;
916    if (sr_ord == ringorder_lp) r->order[i] = ringorder_Wp;
917    else if (sr_ord == ringorder_ls) r->order[i] = ringorder_Ws;
918    else if (sr_ord != ringorder_wp && sr_ord != ringorder_ws &&
919             sr_ord != ringorder_a)
920      return mpsr_Failure;
921  }
922
923  MPT_Annot_pt
924    annot2 = MPT_Annot(node, MP_ProtoDict, MP_AnnotProtoPrototype);
925
926  if (annot2 == NULL ||
927      ! NodeCheck(annot2->value->node, MP_CommonMetaType, MP_ProtoDict,
928                 MP_CmtProtoIMP_Sint32))
929    return mpsr_Failure;
930
931  MP_Uint32_t nc = node->numchild, j;
932  MP_Sint32_t *w = (MP_Sint32_t *) annot->value->args;
933  short *w2 = (short *) AllocL(nc*sizeof(short));
934 
935  r->wvhdl[i] = w2;
936  for (j = 0; j < nc ; j++)
937    w2[j] = w[j];
938
939  return mpsr_Success;
940}
941
942static mpsr_Status_t GetDefRelsAnnot(MPT_Node_pt node, ring r)
943{
944  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyDefRel);
945  mpsr_leftv mlv;
946  leftv lv;
947  ring r1;
948
949  if (annot == NULL) return mpsr_Success;
950
951  node = annot->value->node;
952  if (node->type != MPT_ExternalDataType) return mpsr_Failure;
953
954  mlv = (mpsr_leftv) annot->value->args;
955  r1 = mlv->r;
956  lv = mlv->lv;
957
958  if (! rEqual(r1, r)) return mpsr_Failure;
959
960  if (lv->rtyp == POLY_CMD)
961  {
962    r->qideal = idInit(1,1);
963    r->qideal->m[0] = (poly) lv->data;
964    lv->data = NULL;
965  }
966  else if (lv->rtyp == IDEAL_CMD)
967  {
968    r->qideal = (ideal) lv->data;
969    lv->data = NULL;
970  }
971  else return mpsr_Failure;
972 
973  return mpsr_Success;
974}
975 
976extern mpsr_Status_t mpsr_rSetOrdSgn(ring r)
977{
978  short i = 0, order;
979  r->OrdSgn = 1;
980
981  while ((order = r->order[i]) != ringorder_no)
982  {
983    if (order == ringorder_ls ||
984        order == ringorder_Ws ||
985        order == ringorder_ws ||
986        order == ringorder_Ds ||
987        order == ringorder_ds)
988    {
989      r->OrdSgn = -1;
990      return mpsr_Success;
991    }
992    if (order == ringorder_M)
993    {
994      int sz = r->block1[i] - r->block0[i] + 1, j, k=0;
995      short *matrix = r->wvhdl[i];
996     
997      while (k < sz)
998      {
999        j = 0;
1000        while ((j < sz) && matrix[j*sz+k]==0) j++;
1001        if (j>=sz)
1002        {
1003          Warn("Matrix order not complete");
1004          r->OrdSgn = 0;
1005          return mpsr_Failure;
1006        }
1007        else if (matrix[j*sz+k]<0)
1008        {
1009          r->OrdSgn = -1;
1010          return mpsr_Success;
1011        }
1012        else
1013          k++;
1014      }
1015    }
1016    i++;
1017  }
1018  return mpsr_Success;
1019}
1020
1021#endif
Note: See TracBrowser for help on using the repository browser.