source: git/Singular/mpsr_GetPoly.cc @ 416465

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