source: git/Singular/mpsr_GetPoly.cc @ 50cbdc

fieker-DuValspielwiese
Last change on this file since 50cbdc was 50cbdc, checked in by Hans Schönemann <hannes@…>, 23 years ago
*hannes: merge-2-0-2 git-svn-id: file:///usr/local/Singular/svn/trunk@5619 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 25.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/* $Id: mpsr_GetPoly.cc,v 1.32 2001-08-27 14:47:16 Singular 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 "mylimits.h"
19
20#include "mpsr_Get.h"
21
22#include "gmp.h"
23#include "omalloc.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) omAlloc0Bin(rnumber_bin);
233#if defined(LDEBUG)
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) omAlloc0Bin(rnumber_bin);
253    y = (number) *x;
254#if defined(LDEBUG)
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) omAlloc0Bin(rnumber_bin);
278      y = (number) *x;
279#if defined(LDEBUG)
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, napoly *p)
304{
305  MP_Uint32_t j, nm;
306  int i;
307  napoly a;
308  int *exp;
309
310  IMP_GetUint32(link, &nm);
311
312  if (nm == 0)
313  {
314    *p = NULL;
315    return mpsr_Success;
316  }
317  a = napNew();
318  *p = a;
319
320  failr(GetAlgNumberNumber(link, &(napGetCoeff(a))));
321  mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &gTa, naNumbOfPar));
322  for (i=0; i<naNumbOfPar; i++)
323    napSetExp(a,i+1,gTa[i]);
324
325  for (j=1; j<nm; j++)
326  {
327    napNext(a) = napNew();
328    napIter(a);
329    failr(GetAlgNumberNumber(link, &(napGetCoeff(a))));
330    mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &gTa, naNumbOfPar));
331    for (i=0; i<naNumbOfPar; i++)
332      napSetExp(a,i+1,gTa[i]);
333  }
334  napNext(a) = NULL;
335
336  return mpsr_Success;
337}
338
339static mpsr_Status_t GetAlgNumber(MP_Link_pt link, number *a)
340{
341  lnumber b;
342  MP_Uint32_t ut;
343
344  // Get the union tag
345  mp_failr(IMP_GetUint32(link, &ut));
346  if (ut == 0)
347  {
348    *a = NULL;
349    return mpsr_Success;
350  }
351  else if (ut == 1 || ut == 2)
352  {
353    // single number
354    b = (lnumber) omAlloc0Bin(rnumber_bin);
355    *a = (number) b;
356    failr(GetAlgPoly(link, &(b->z)));
357    if (ut == 2)
358      return GetAlgPoly(link, &(b->n));
359    else
360      return mpsr_Success;
361  }
362  else
363    return mpsr_SetError(mpsr_WrongUnionDiscriminator);
364}
365
366/***************************************************************
367 *
368 *  Getting polys
369 *
370 ***************************************************************/
371mpsr_Status_t mpsr_GetPoly(MP_Link_pt link, poly &p, MP_Uint32_t nmon,
372                         ring cring)
373{
374  poly pp;
375  MP_Sint32_t i;
376  MP_Uint32_t j;
377
378  if (! IsCurrGetRing(cring))
379    SetGetFuncs(cring);
380
381  if (nmon == 0)
382  {
383    p = NULL;
384    return mpsr_Success;
385  }
386
387  pp = pInit();
388  p = pp;
389  failr(GetCoeff(link, &(pp->coef)));
390  if (gNvars > 1)
391  {
392    MP_Sint32_t* Ta = &gTa[1];
393    mp_failr(IMP_GetSint32Vector(link, &Ta, gNvars));
394    for (i=1; i<=gNvars; i++)
395      pSetExp(pp,i , (Exponent_t) gTa[i]);
396    pSetm(pp);
397
398    for (j=1; j<nmon; j++)
399    {
400      pp->next = pInit();
401      pp = pp->next;
402      failr(GetCoeff(link, &(pp->coef)));
403      mp_failr(IMP_GetSint32Vector(link, &Ta, gNvars));
404      for (i=1; i<=gNvars; i++)
405        pSetExp(pp, i, (Exponent_t) gTa[i]);
406      pSetm(pp);
407    }
408  }
409  else
410  {
411    mp_failr(IMP_GetSint32(link, &i));
412    pSetExp(pp,1, (Exponent_t) i);
413    pSetm(pp);
414
415    for (j=1; j<nmon; j++)
416    {
417      pp->next = pInit();
418      pp = pp->next;
419      failr(GetCoeff(link, &(pp->coef)));
420      mp_failr(IMP_GetSint32(link, &i));
421      pSetExp(pp,1, (Exponent_t) i);
422      pSetm(pp);
423    }
424  }
425
426  pp->next = NULL;
427
428  return mpsr_Success;
429}
430
431mpsr_Status_t mpsr_GetPolyVector(MP_Link_pt link, poly &p, MP_Uint32_t nmon,
432                          ring cring)
433{
434  poly pp;
435  MP_Sint32_t i, n1;
436  MP_Uint32_t j;
437
438  if (!IsCurrGetRing(cring))
439    SetGetFuncs(cring);
440
441  n1 = gNvars + 1;
442  if (nmon == 0)
443  {
444    p = NULL;
445    return mpsr_Success;
446  }
447
448  pp = pInit();
449  p = pp;
450  failr(GetCoeff(link, &(pp->coef)));
451  if (gNvars > 1)
452  {
453    mp_failr(IMP_GetSint32Vector(link, &gTa, n1));
454    pSetComp(pp, gTa[0]);
455    for (i=1; i<n1; i++)
456      pSetExp(pp, i, (Exponent_t) gTa[i]);
457    pSetm(pp);
458
459    for (j=1; j<nmon; j++)
460    {
461      pp->next = pInit();
462      pp = pp->next;
463      failr(GetCoeff(link, &(pp->coef)));
464      mp_failr(IMP_GetSint32Vector(link, &gTa, n1));
465      pSetComp(pp, gTa[0]);
466      for (i=1; i<n1; i++)
467        pSetExp(pp,i, (Exponent_t) gTa[i]);
468      pSetm(pp);
469    }
470  }
471  else
472  {
473    mp_failr(IMP_GetSint32(link, &i));
474    pSetComp(pp, i);
475    mp_failr(IMP_GetSint32(link, &i));
476    pSetExp(pp,1, (Exponent_t) i);
477    pSetm(pp);
478
479    for (j=1; j<nmon; j++)
480    {
481      pp->next = pInit();
482      pp = pp->next;
483      failr(GetCoeff(link, &(pp->coef)));
484      mp_failr(IMP_GetSint32(link, &i));
485      pSetComp(pp, i);
486      mp_failr(IMP_GetSint32(link, &i));
487      pSetExp(pp,1, (Exponent_t) i);
488      pSetm(pp);
489    }
490  }
491  pp->next = NULL;
492
493  return mpsr_Success;
494}
495
496/***************************************************************
497 *
498 *  The Getting annotation buisness
499 *
500 ***************************************************************/
501#define falser(x)                               \
502do                                              \
503{                                               \
504  if (!(x)) return mpsr_Failure;                   \
505}                                               \
506while (0)
507
508// We assume that the node is that of a DDP: This returns
509// MP_Succcess, if annots of node can be used to construct a
510// Singular ring (in which case r is the respective ring) or,
511// MP_Failure, if not
512mpsr_Status_t mpsr_GetRingAnnots(MPT_Node_pt node, ring &r,
513                                 BOOLEAN &mv, BOOLEAN &IsUnOrdered)
514{
515  sip_sring r1, *subring;
516  poly minpoly = NULL;
517
518  memset(&r1, 0, sizeof(sip_sring));
519
520  r = NULL;
521  if (MPT_Annot(node, MP_PolyDict, MP_AnnotPolyModuleVector) != NULL)
522    mv = 1;
523  else
524    mv = 0;
525
526  // sets r->N
527  if (GetVarNumberAnnot(node, &r1, mv) != mpsr_Success)
528    Warn("GetVarNumberAnnot: using the one found in the prototype");
529
530  // sets r->char and r->minpoly, r->parameter; if necessary
531  failr(GetProtoTypeAnnot(node, &r1, mv, subring));
532
533  // if we are still here, then we are successful in constructing the ring
534  r = (ring) omAllocBin(sip_sring_bin);
535  memcpy(r, &r1, sizeof(sip_sring));
536
537  if (GetVarNamesAnnot(node, r) != mpsr_Success)
538    Warn("GetVarNamesAnnot: using default variable names");
539
540  if (GetOrderingAnnot(node,r, mv, IsUnOrdered) != mpsr_Success)
541    Warn("GetOrderingAnnot: using unspec ordering");
542
543  rComplete(r);
544
545  if (GetDefRelsAnnot(node, r) != mpsr_Success)
546    Warn("GetDefRelsAnnot: using no defining relations");
547
548  // check on whether or not I have to set a minpoly
549  if (subring != NULL)
550  {
551    if ((subring->qideal != NULL) &&
552        ((minpoly = subring->qideal->m[0]) != NULL))
553    {
554      mpsr_SetCurrRing(r, TRUE);
555      minpoly = maIMap(subring, minpoly);
556      r->minpoly = minpoly->coef;
557      pLmFree(minpoly);
558    }
559    rKill(subring);
560  }
561
562  // complete ring constructions
563  return mpsr_Success;
564}
565
566
567static mpsr_Status_t GetVarNumberAnnot(MPT_Node_pt node, ring r, BOOLEAN mv)
568{
569  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyVarNumber);
570
571  if (annot != NULL)
572  {
573    if (annot->value != NULL && annot->value->node->type == MP_Uint32Type)
574    {
575      // Hm.. should check that r->N is not too big for Singular
576      r->N = (short) MP_UINT32_T(annot->value->node->nvalue);
577      if (mv) (r->N)--;
578      return mpsr_Success;
579    }
580  }
581  return mpsr_Failure;
582}
583
584
585static mpsr_Status_t GetProtoTypeAnnot(MPT_Node_pt node, ring r, BOOLEAN mv,
586                                       ring &subring)
587{
588  MPT_Annot_pt annot = NULL;
589  MPT_Tree_pt  val;
590  MPT_Tree_pt  *ta;
591
592  subring = NULL;
593
594  // look for prototype annot
595  if ((val = MPT_ProtoAnnotValue(node)) == NULL)
596    return mpsr_Failure;
597
598  // check value of annot
599  node = val->node;
600  if (! (NodeCheck(node, MP_CommonOperatorType, MP_ProtoDict,
601                   MP_CopProtoStruct) && node->numchild == 2))
602    return mpsr_Failure;
603  // get the two args of the value
604  ta = (MPT_Tree_pt *) val->args;
605
606
607  // We get the exponent vector specification first
608  node = ta[1]->node;
609  if (! (NodeCheck(node, MP_CommonMetaOperatorType, MP_ProtoDict,
610                   MP_CopProtoArray) && node->numchild > 0))
611    return mpsr_Failure;
612  // check r->N and reset, if necessary
613  if (mv)
614  {
615    if (r->N != (int) (node->numchild - 1))
616    {
617      Warn("GetProtoAnnot: Inconsistent NumVars specification");
618      r->N = (node->numchild -1);
619    }
620  }
621  else
622  {
623    if (r->N != (int) node->numchild)
624    {
625      Warn("GetProtoAnnot: Inconsistent NumVars specification");
626      r->N = (node->numchild);
627    }
628  }
629  // check for type of exponent
630  if ((val = MPT_ProtoAnnotValue(node)) == NULL)
631    return mpsr_Failure;
632
633  node = val->node;
634  falser(NodeCheck(node, MP_CommonMetaType, MP_ProtoDict, MP_CmtProtoIMP_Sint32));
635
636  // consider the first arg -- which specify the coeffs
637  val = ta[0];
638  node = val->node;
639  if (node->type == MP_CommonMetaType)
640  {
641    // char 0
642    if (MP_COMMON_T(node->nvalue) == MP_CmtNumberRational &&
643        node->dict == MP_NumberDict)
644    {
645      r->ch = 0;
646      // Hmm ... we should check for the normalized annot
647    }
648    else if (MP_COMMON_T(node->nvalue) == MP_CmtProtoIMP_Uint32 &&
649             node->dict == MP_ProtoDict &&
650             (annot = MPT_Annot(node,MP_NumberDict,MP_AnnotNumberModulos))
651              != NULL)
652    {
653      // char p || GF(p,n)
654      falser(annot->value != NULL &&
655             annot->value->node->type == MP_Uint32Type);
656      r->ch = MP_UINT32_T(annot->value->node->nvalue);
657
658      if (MPT_Annot(annot->value->node,
659                        MP_NumberDict, MP_AnnotNumberIsPrime) == NULL)
660      {
661        // GF(p,n)
662        falser((annot = MPT_Annot(annot->value->node, 129,
663                                  MP_AnnotSingularGalois)) != NULL &&
664           (annot->value != NULL) &&
665           (annot->value->node->type == MP_StringType));
666        r->parameter = (char **)omAllocBin(char_ptr_bin);
667        r->parameter[0] = omStrDup(MP_STRING_T(annot->value->node->nvalue));
668        r->P = 1;
669      }
670    }
671    else if (MP_COMMON_T(node->nvalue) == MP_CmtProtoIMP_Real32 &&
672             node->dict == MP_ProtoDict)
673    {
674      // floats
675      r->ch = -1;
676    }
677    else
678      return mpsr_SetError(mpsr_UnknownCoeffDomain);
679
680    return mpsr_Success;
681  }
682  else
683  {
684    // alg numbers
685    BOOLEAN mv2, IsUnOrdered;
686    int i;
687
688    // DDP Frac Node check
689    falser(NodeCheck(node, MP_CommonMetaOperatorType, MP_BasicDict,
690                    MP_CopBasicDiv) &&
691           node->numchild == 0);
692    falser((val = MPT_ProtoAnnotValue(node)) != NULL);
693    node = val->node;
694    mpsr_assume(node != NULL);
695    falser(NodeCheck(node, MP_CommonMetaOperatorType, MP_PolyDict,
696                     MP_CopPolyDenseDistPoly) &&
697           node->numchild == 0);
698    // GetRingAnnots
699    failr(mpsr_GetRingAnnots(node, subring, mv2, IsUnOrdered));
700    // Check whether the ring can be "coerced" to an algebraic number
701    falser( (rField_is_Zp(subring)||rField_is_Q(subring)) &&
702           // orig: subring->ch >= 0 &&a ???
703           subring->order[0] == ringorder_lp &&
704           subring->order[2] == 0 &&
705           mv2 == FALSE &&
706           IsUnOrdered == FALSE);
707
708    // Now do the coercion
709    r->ch = (rField_is_Q(subring) ? 1 : - rChar(subring));
710    r->parameter = (char **) omAlloc((subring->N)*sizeof(char*));
711    r->P = subring->N;
712    for (i=0; i < subring->N; i++)
713      r->parameter[i] = omStrDup(subring->names[i]);
714
715    // everything is ok
716    return mpsr_Success;
717  }
718}
719
720static mpsr_Status_t GetVarNamesAnnot(MPT_Node_pt node, ring r)
721{
722  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyVarNames);
723  short num_vars = 0, N, lb, offset, nc;
724
725  mpsr_assume(r != NULL);
726  N = r->N;
727  r->names = (char **) omAlloc0(N * sizeof(char *));
728
729  // fill in varnames from the back
730  if (annot != NULL && annot->value != NULL)
731  {
732    node = annot->value->node;
733    nc = (short) node->numchild;
734    if (NodeCheck(node, MP_CommonOperatorType, MP_ProtoDict, MP_CopProtoArray))
735    {
736      MPT_Tree_pt val = MPT_ProtoAnnotValue(node);
737      if (val != NULL &&
738          NodeCheck(val->node, MP_CommonMetaType, MP_ProtoDict,
739                    MP_CmtProtoIMP_Identifier))
740      {
741        MPT_Arg_pt arg_pt = annot->value->args;
742        lb = min(nc, N);
743        offset = N - (short) nc;
744        if (offset < 0) offset = 0;
745        for (; num_vars < lb; num_vars++)
746          r->names[offset + num_vars] =
747            omStrDup(MP_STRING_T(arg_pt[num_vars]));
748      }
749    }
750    else if (node->type == MP_IdentifierType)
751    {
752      r->names[N-1] = omStrDup(MP_STRING_T(annot->value->node->nvalue));
753      num_vars = 1;
754    }
755  }
756
757  // fill in all remaining varnames
758  if (num_vars < N)
759  {
760    char vn[10];
761    offset = N - num_vars;
762    for (nc = 0; nc < offset; nc++)
763    {
764      sprintf(vn, "x(%d)", nc);
765      r->names[nc] = omStrDup(vn);
766    }
767  }
768
769  if (num_vars < N) return mpsr_Failure;
770  else return mpsr_Success;
771}
772
773static mpsr_Status_t GetOrderingAnnot(MPT_Node_pt node, ring r,
774                                      BOOLEAN mv, BOOLEAN &IsUnOrdered)
775{
776  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict,
777                                 MP_AnnotShouldHavePolyOrdering);
778  IsUnOrdered = FALSE;
779  mpsr_Status_t status = mpsr_Success;
780  if (annot == NULL)
781  {
782    annot = MPT_Annot(node, MP_PolyDict,MP_AnnotPolyOrdering);
783    if (annot == NULL) status = mpsr_Failure;
784  }
785  else
786  {
787    IsUnOrdered = TRUE;
788  }
789
790
791  if (status == mpsr_Success) node =  annot->value->node;
792
793  // Check for BlockOrdering
794  if (status == mpsr_Success &&
795      NodeCheck(annot->value->node, MP_CommonOperatorType,
796               MP_BasicDict, MP_CopBasicList))
797  {
798    MP_NumChild_t nc = node->numchild, i;
799    MPT_Tree_pt *tarray = (MPT_Tree_pt *) annot->value->args, *tarray2, tree;
800
801    if (! mv) nc += 2; else nc++;
802    r->block0 = (int *) omAlloc0(nc*sizeof(int *));
803    r->block1 = (int *) omAlloc0(nc*sizeof(int *));
804    r->wvhdl  = (int **) omAlloc0(nc*sizeof(int *));
805    r->order  = (int *) omAlloc0(nc*sizeof(int *));
806
807    if (! mv)
808    {
809      r->order[nc-2] = ringorder_C;
810      nc = nc - 2;
811    }
812    else
813      nc--;
814
815    for (i=0; i<nc; i++)
816    {
817      tree = tarray[i];
818      if (NodeCheck(tree->node, MP_CommonOperatorType,
819                   MP_BasicDict, MP_CopBasicList) &&
820          tree->node->numchild == 3)
821      {
822        tarray2 = (MPT_Tree_pt *) tree->args;
823        if (GetSimpleOrdering(tarray2[0]->node, r, i) != mpsr_Success ||
824            tarray2[1]->node->type != MP_Uint32Type ||
825            tarray2[2]->node->type != MP_Uint32Type)
826        {
827          status = mpsr_Failure;
828          break;
829        }
830        else
831        {
832          r->block0[i] = MP_SINT32_T(tarray2[1]->node->nvalue);
833          r->block1[i] = MP_SINT32_T(tarray2[2]->node->nvalue);
834        }
835      }
836      else
837      {
838          status = mpsr_Failure;
839          break;
840      }
841    }
842
843    if (status == mpsr_Success) status = mpsr_rSetOrdSgn(r);
844
845    // Clean up if sth went wrong
846    if (status == mpsr_Failure)
847    {
848      if (mv) nc++;
849      else nc += 2;
850      omFreeSize(r->block0, nc*sizeof(int *));
851      omFreeSize(r->block1, nc*sizeof(int *));
852      omFreeSize(r->order, nc*sizeof(int *));
853      omFreeSize(r->wvhdl, nc*sizeof(short *));
854    }
855    else
856      return mpsr_Success;
857  }
858
859  // Either Simple Ordering, or sth failed from before
860  r->wvhdl = (int **)omAlloc0(3 * sizeof(int *));
861  r->order = (int *) omAlloc0(3 * sizeof(int *));
862  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
863  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
864  r->order[1] = ringorder_C;
865  r->block0[0] = 1;
866  r->block1[0] = r->N;
867
868  // Check for simple Ordering
869  if (status == mpsr_Success)
870    status = GetSimpleOrdering(node, r, 0);
871
872  if (status != mpsr_Success)
873  {
874    r->order[0] = ringorder_unspec;
875    IsUnOrdered = FALSE;
876  }
877
878  return mpsr_rSetOrdSgn(r);
879}
880
881static mpsr_Status_t GetSimpleOrdering(MPT_Node_pt node, ring r, short i)
882{
883  if (node->type != MP_CommonConstantType)
884    return mpsr_Failure;
885
886  int sr_ord =  mpsr_mp2ord(MP_COMMON_T(node->nvalue));
887
888  r->order[i] = sr_ord;
889  if (r->order[i] == ringorder_unspec) return mpsr_Failure;
890
891  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyWeights);
892
893  if (annot == NULL) return mpsr_Success;
894  if (annot->value == NULL) return mpsr_Failure;
895
896  node = annot->value->node;
897  if (r->order[i] == ringorder_M)
898  {
899    if (! NodeCheck(node, MP_CommonOperatorType, MP_MatrixDict,
900                   MP_CopMatrixDenseMatrix))
901      return mpsr_Failure;
902  }
903  else
904  {
905    if (! NodeCheck(node, MP_CommonOperatorType, MP_MatrixDict,
906                    MP_CopMatrixDenseVector))
907      return mpsr_Failure;
908    if (sr_ord == ringorder_lp) r->order[i] = ringorder_Wp;
909    else if (sr_ord == ringorder_ls) r->order[i] = ringorder_Ws;
910    else if (sr_ord != ringorder_wp && sr_ord != ringorder_ws &&
911             sr_ord != ringorder_a)
912      return mpsr_Failure;
913  }
914
915  MPT_Annot_pt
916    annot2 = MPT_Annot(node, MP_ProtoDict, MP_AnnotProtoPrototype);
917
918  if (annot2 == NULL ||
919      ! NodeCheck(annot2->value->node, MP_CommonMetaType, MP_ProtoDict,
920                 MP_CmtProtoIMP_Sint32))
921    return mpsr_Failure;
922
923  MP_Uint32_t nc = node->numchild, j;
924  MP_Sint32_t *w = (MP_Sint32_t *) annot->value->args;
925  int *w2 = (int *) omAlloc(nc*sizeof(int));
926
927  r->wvhdl[i] = w2;
928  for (j = 0; j < nc ; j++)
929    w2[j] = w[j];
930
931  return mpsr_Success;
932}
933
934static mpsr_Status_t GetDefRelsAnnot(MPT_Node_pt node, ring r)
935{
936  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyDefRel);
937  mpsr_leftv mlv;
938  leftv lv;
939  ring r1;
940
941  if (annot == NULL) return mpsr_Success;
942
943  node = annot->value->node;
944  if (node->type != MPT_ExternalDataType) return mpsr_Failure;
945
946  mlv = (mpsr_leftv) annot->value->args;
947  r1 = mlv->r;
948  lv = mlv->lv;
949
950  if (! rEqual(r1, r)) return mpsr_Failure;
951
952  if (lv->rtyp == POLY_CMD)
953  {
954    r->qideal = idInit(1,1);
955    r->qideal->m[0] = (poly) lv->data;
956    lv->data = NULL;
957  }
958  else if (lv->rtyp == IDEAL_CMD)
959  {
960    r->qideal = (ideal) lv->data;
961    lv->data = NULL;
962  }
963  else return mpsr_Failure;
964
965  return mpsr_Success;
966}
967
968extern mpsr_Status_t mpsr_rSetOrdSgn(ring r)
969{
970  short i = 0, order;
971  r->OrdSgn = 1;
972
973  while ((order = r->order[i]) != ringorder_no)
974  {
975    if (order == ringorder_ls ||
976        order == ringorder_Ws ||
977        order == ringorder_ws ||
978        order == ringorder_Ds ||
979        order == ringorder_ds)
980    {
981      r->OrdSgn = -1;
982      return mpsr_Success;
983    }
984    if (order == ringorder_M)
985    {
986      int sz = r->block1[i] - r->block0[i] + 1, j, k=0;
987      int *matrix = r->wvhdl[i];
988
989      while (k < sz)
990      {
991        j = 0;
992        while ((j < sz) && matrix[j*sz+k]==0) j++;
993        if (j>=sz)
994        {
995          Warn("Matrix order not complete");
996          r->OrdSgn = 0;
997          return mpsr_Failure;
998        }
999        else if (matrix[j*sz+k]<0)
1000        {
1001          r->OrdSgn = -1;
1002          return mpsr_Success;
1003        }
1004        else
1005          k++;
1006      }
1007    }
1008    i++;
1009  }
1010  return mpsr_Success;
1011}
1012#endif
Note: See TracBrowser for help on using the repository browser.