[32df82] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
| 4 | |
---|
[416465] | 5 | /* $Id: mpsr_GetPoly.cc,v 1.26 1999-11-15 17:20:33 obachman Exp $ */ |
---|
[32df82] | 6 | |
---|
[0e1846] | 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 |
---|
[feaddd] | 18 | #include "limits.h" |
---|
[0e1846] | 19 | |
---|
| 20 | #include "mpsr_Get.h" |
---|
| 21 | |
---|
| 22 | #include "gmp.h" |
---|
| 23 | #include "mmemory.h" |
---|
| 24 | #include "tok.h" |
---|
| 25 | #include "ipid.h" |
---|
[a9a7be] | 26 | #include "ring.h" |
---|
[0e1846] | 27 | #include "longalg.h" |
---|
| 28 | #include "maps.h" |
---|
| 29 | #include "ideals.h" |
---|
| 30 | #include "grammar.h" |
---|
| 31 | #include "febase.h" |
---|
[e6969d] | 32 | #include "modulop.h" |
---|
[0e1846] | 33 | |
---|
| 34 | #include "mpsr_Tok.h" |
---|
| 35 | |
---|
| 36 | #ifdef PARI_BIGINT_TEST |
---|
| 37 | #include "MP_PariBigInt.h" |
---|
| 38 | |
---|
| 39 | MP_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 | |
---|
| 61 | static mpsr_Status_t (*GetCoeff)(MP_Link_pt link, number *x); |
---|
| 62 | static mpsr_Status_t (*GetAlgNumberNumber)(MP_Link_pt link, number *x); |
---|
| 63 | static MP_Sint32_t gNalgvars = 0; |
---|
| 64 | static MP_Sint32_t gNvars = 0; |
---|
| 65 | static ring currGetRing = NULL; |
---|
| 66 | |
---|
| 67 | |
---|
| 68 | /*************************************************************** |
---|
| 69 | * |
---|
| 70 | * prototype declarations |
---|
| 71 | * |
---|
| 72 | ***************************************************************/ |
---|
| 73 | static void SetGetFuncs(ring r); |
---|
| 74 | static mpsr_Status_t GetModuloNumber(MP_Link_pt link, number *a); |
---|
[126cfa] | 75 | static mpsr_Status_t GetGaloisNumber(MP_Link_pt link, number *a); |
---|
[0e1846] | 76 | static mpsr_Status_t GetFloatNumber(MP_Link_pt link, number *a); |
---|
| 77 | static mpsr_Status_t GetApInt(MP_Link_pt link, mpz_ptr ap); |
---|
| 78 | static mpsr_Status_t GetRationalNumber(MP_Link_pt link, number *a); |
---|
| 79 | static mpsr_Status_t GetAlgNumber(MP_Link_pt link, number *a); |
---|
| 80 | static mpsr_Status_t GetVarNumberAnnot(MPT_Node_pt node, ring r, BOOLEAN mv); |
---|
| 81 | static mpsr_Status_t GetProtoTypeAnnot(MPT_Node_pt node, ring r, BOOLEAN mv, |
---|
| 82 | ring &subring); |
---|
[12310e] | 83 | static mpsr_Status_t GetOrderingAnnot(MPT_Node_pt node, ring r, BOOLEAN mv, |
---|
| 84 | BOOLEAN &IsUnOrdered); |
---|
[0e1846] | 85 | static mpsr_Status_t GetSimpleOrdering(MPT_Node_pt node, ring r, short i); |
---|
| 86 | static mpsr_Status_t GetVarNamesAnnot(MPT_Node_pt node, ring r); |
---|
| 87 | static mpsr_Status_t GetDefRelsAnnot(MPT_Node_pt node, ring r); |
---|
| 88 | |
---|
| 89 | /*************************************************************** |
---|
| 90 | * |
---|
| 91 | * Setting the global Put Functions |
---|
| 92 | * |
---|
| 93 | ***************************************************************/ |
---|
| 94 | |
---|
| 95 | static inline BOOLEAN IsCurrGetRing(ring r) |
---|
| 96 | { |
---|
| 97 | if (r == currGetRing && r == currRing) return 1; |
---|
| 98 | else return 0; |
---|
| 99 | } |
---|
| 100 | |
---|
| 101 | static void SetGetFuncs(ring r) |
---|
| 102 | { |
---|
| 103 | currGetRing = r; |
---|
| 104 | // first, we set the PutNumber function |
---|
[550b4c] | 105 | gNvars = r->N; |
---|
| 106 | mpsr_InitTempArray(gNvars + 1); |
---|
[0e1846] | 107 | |
---|
[be0d84] | 108 | if (rField_is_Q(r)) |
---|
[0e1846] | 109 | // rational numbers |
---|
| 110 | GetCoeff = GetRationalNumber; |
---|
[be0d84] | 111 | else if (rField_is_Zp(r)) |
---|
| 112 | GetCoeff = GetModuloNumber; |
---|
| 113 | else if (rField_is_GF(r)) |
---|
[126cfa] | 114 | GetCoeff = GetGaloisNumber; |
---|
[be0d84] | 115 | else if (rField_is_R(r)) |
---|
[0e1846] | 116 | GetCoeff = GetFloatNumber; |
---|
| 117 | else |
---|
| 118 | { |
---|
| 119 | // now we come to algebraic numbers |
---|
| 120 | gNalgvars = rPar(r); |
---|
[550b4c] | 121 | mpsr_InitTempArray(gNalgvars); |
---|
[0e1846] | 122 | GetCoeff = GetAlgNumber; |
---|
[be0d84] | 123 | if (rField_is_Zp_a(r)) |
---|
[0e1846] | 124 | // first, Z/p(a) |
---|
| 125 | GetAlgNumberNumber = GetModuloNumber; |
---|
| 126 | else |
---|
| 127 | GetAlgNumberNumber = GetRationalNumber; |
---|
| 128 | } |
---|
[a9a7be] | 129 | |
---|
[0e1846] | 130 | // still need to set the global ring |
---|
[e6969d] | 131 | mpsr_SetCurrRing(r, TRUE); |
---|
[0e1846] | 132 | } |
---|
| 133 | |
---|
| 134 | |
---|
| 135 | |
---|
| 136 | /*************************************************************** |
---|
| 137 | * |
---|
[a9a7be] | 138 | * Routines for Getting coeffs |
---|
[0e1846] | 139 | * |
---|
| 140 | ***************************************************************/ |
---|
| 141 | // we always Get modulo numbers without a node, since |
---|
| 142 | // we have type-spec this before |
---|
| 143 | static mpsr_Status_t GetModuloNumber(MP_Link_pt link, number *a) |
---|
| 144 | { |
---|
[e6969d] | 145 | MP_Uint32_t x; |
---|
| 146 | mp_failr(IMP_GetUint32(link, &x)); |
---|
| 147 | *a=npInit((int)x); |
---|
| 148 | return mpsr_Success; |
---|
[0e1846] | 149 | } |
---|
| 150 | |
---|
[126cfa] | 151 | static mpsr_Status_t GetGaloisNumber(MP_Link_pt link, number *a) |
---|
| 152 | { |
---|
| 153 | mp_return(IMP_GetUint32(link, (MP_Uint32_t *) a)); |
---|
| 154 | } |
---|
| 155 | |
---|
[0e1846] | 156 | static mpsr_Status_t GetFloatNumber(MP_Link_pt link, number *a) |
---|
| 157 | { |
---|
| 158 | mp_return( IMP_GetReal32(link , (MP_Real32_t *) a)); |
---|
| 159 | } |
---|
| 160 | |
---|
| 161 | static 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; |
---|
[a9a7be] | 169 | |
---|
[feaddd] | 170 | mp_failr(IMP_GetNodeHeader(link,&node,&dict, &cvalue, &num_annots, |
---|
[0e1846] | 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); |
---|
[a9a7be] | 198 | |
---|
[0e1846] | 199 | if (num_annots > 0) |
---|
| 200 | { |
---|
| 201 | mpt_failr(MPT_SkipAnnots(link, num_annots, &req)); |
---|
| 202 | if (req) return mpsr_SetError(mpsr_ReqAnnotSkip); |
---|
| 203 | } |
---|
[a9a7be] | 204 | |
---|
[0e1846] | 205 | return mpsr_Success; |
---|
| 206 | } |
---|
[a9a7be] | 207 | |
---|
[0e1846] | 208 | // This supposes that number is of char 0, i.e. a rational number |
---|
| 209 | static 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 | |
---|
[feaddd] | 220 | mp_failr(IMP_GetNodeHeader(link,&node,&dict, &cvalue, &num_annots, |
---|
| 221 | &num_child)); |
---|
[0e1846] | 222 | |
---|
| 223 | // start with the most frequent cases |
---|
[a9a7be] | 224 | if (node == MP_Sint32Type) |
---|
[0e1846] | 225 | { |
---|
| 226 | mp_failr(IMP_GetSint32(link, &i)); |
---|
| 227 | *x = nlInit(i); |
---|
| 228 | } |
---|
| 229 | else if (node == MP_ApIntType) |
---|
| 230 | { |
---|
| 231 | mpz_ptr gnum; |
---|
[b7b08c] | 232 | y = (number) Alloc0SizeOf(rnumber); |
---|
| 233 | #if defined(LDEBUG) && ! defined(HAVE_ASO) |
---|
[97454d] | 234 | y->debug = 123456; |
---|
| 235 | #endif |
---|
[0e1846] | 236 | y->s = 3; |
---|
| 237 | gnum = &(y->z); |
---|
| 238 | mpz_init(gnum); |
---|
| 239 | mp_failr(IMP_MyGetApInt(link, (MP_ApInt_t *) &gnum)); |
---|
[92e539] | 240 | *x = nlInit(y); |
---|
[0e1846] | 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 | } |
---|
[b7b08c] | 252 | *x = (number) Alloc0SizeOf(rnumber); |
---|
[0e1846] | 253 | y = (number) *x; |
---|
[b7b08c] | 254 | #if defined(LDEBUG) && ! defined(HAVE_ASO) |
---|
[97454d] | 255 | y->debug = 123456; |
---|
| 256 | #endif |
---|
[0e1846] | 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 |
---|
[b7b08c] | 277 | *x = (number) Alloc0SizeOf(rnumber); |
---|
[0e1846] | 278 | y = (number) *x; |
---|
[b7b08c] | 279 | #if defined(LDEBUG) && ! defined(HAVE_ASO) |
---|
[97454d] | 280 | y->debug = 123456; |
---|
| 281 | #endif |
---|
[0e1846] | 282 | mpz_init_set_ui(&(y->z), ui); |
---|
| 283 | y->s = 3; |
---|
| 284 | } |
---|
| 285 | } |
---|
| 286 | else |
---|
| 287 | return mpsr_SetError(mpsr_WrongNodeType); |
---|
[a9a7be] | 288 | |
---|
[0e1846] | 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 | ***************************************************************/ |
---|
| 303 | static inline mpsr_Status_t GetAlgPoly(MP_Link_pt link, alg *p) |
---|
| 304 | { |
---|
| 305 | MP_Uint32_t j, nm; |
---|
[09d74fe] | 306 | int i; |
---|
[0e1846] | 307 | alg a; |
---|
[09d74fe] | 308 | #if SIZEOF_INT == SIZEOF_PARAMETER |
---|
| 309 | Exponent_t *exp; |
---|
| 310 | #else |
---|
| 311 | int *exp; |
---|
| 312 | #endif |
---|
[0e1846] | 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))); |
---|
[550b4c] | 325 | #if SIZEOF_INT == SIZEOF_PARAMETER |
---|
[0e1846] | 326 | exp = &(a->e[0]); |
---|
| 327 | mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &exp, naNumbOfPar)); |
---|
[550b4c] | 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]; |
---|
[a9a7be] | 332 | #endif |
---|
[0e1846] | 333 | |
---|
| 334 | for (j=1; j<nm; j++) |
---|
| 335 | { |
---|
| 336 | a->ne = napNew(); |
---|
| 337 | a = a->ne; |
---|
| 338 | failr(GetAlgNumberNumber(link, &(a->ko))); |
---|
[550b4c] | 339 | #if SIZEOF_INT == SIZEOF_PARAMETER |
---|
[0e1846] | 340 | exp = &(a->e[0]); |
---|
| 341 | mp_failr(IMP_GetSint32Vector(link, (MP_Sint32_t **) &exp, naNumbOfPar)); |
---|
[550b4c] | 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]; |
---|
[a9a7be] | 346 | #endif |
---|
[0e1846] | 347 | } |
---|
| 348 | a->ne = NULL; |
---|
| 349 | |
---|
| 350 | return mpsr_Success; |
---|
| 351 | } |
---|
| 352 | |
---|
| 353 | static 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 |
---|
[b7b08c] | 368 | b = (lnumber) Alloc0SizeOf(rnumber); |
---|
[0e1846] | 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 | ***************************************************************/ |
---|
| 385 | mpsr_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); |
---|
[a9a7be] | 394 | |
---|
[0e1846] | 395 | if (nmon == 0) |
---|
| 396 | { |
---|
| 397 | p = NULL; |
---|
| 398 | return mpsr_Success; |
---|
| 399 | } |
---|
[a9a7be] | 400 | |
---|
[e78cce] | 401 | pp = pInit(); |
---|
[0e1846] | 402 | p = pp; |
---|
| 403 | failr(GetCoeff(link, &(pp->coef))); |
---|
| 404 | if (gNvars > 1) |
---|
| 405 | { |
---|
[0498af] | 406 | MP_Sint32_t* Ta = &gTa[1]; |
---|
| 407 | mp_failr(IMP_GetSint32Vector(link, &Ta, gNvars)); |
---|
[427ba9] | 408 | for (i=1; i<=gNvars; i++) |
---|
| 409 | pSetExp(pp,i , (Exponent_t) gTa[i]); |
---|
[0e1846] | 410 | pSetm(pp); |
---|
| 411 | |
---|
| 412 | for (j=1; j<nmon; j++) |
---|
| 413 | { |
---|
[e78cce] | 414 | pp->next = pInit(); |
---|
[0e1846] | 415 | pp = pp->next; |
---|
| 416 | failr(GetCoeff(link, &(pp->coef))); |
---|
[0498af] | 417 | mp_failr(IMP_GetSint32Vector(link, &Ta, gNvars)); |
---|
[427ba9] | 418 | for (i=1; i<=gNvars; i++) |
---|
| 419 | pSetExp(pp, i, (Exponent_t) gTa[i]); |
---|
[0e1846] | 420 | pSetm(pp); |
---|
| 421 | } |
---|
| 422 | } |
---|
| 423 | else |
---|
| 424 | { |
---|
| 425 | mp_failr(IMP_GetSint32(link, &i)); |
---|
[427ba9] | 426 | pSetExp(pp,1, (Exponent_t) i); |
---|
[0e1846] | 427 | pSetm(pp); |
---|
[a9a7be] | 428 | |
---|
[0e1846] | 429 | for (j=1; j<nmon; j++) |
---|
| 430 | { |
---|
[e78cce] | 431 | pp->next = pInit(); |
---|
[0e1846] | 432 | pp = pp->next; |
---|
| 433 | failr(GetCoeff(link, &(pp->coef))); |
---|
| 434 | mp_failr(IMP_GetSint32(link, &i)); |
---|
[427ba9] | 435 | pSetExp(pp,1, (Exponent_t) i); |
---|
[0e1846] | 436 | pSetm(pp); |
---|
| 437 | } |
---|
| 438 | } |
---|
| 439 | |
---|
| 440 | pp->next = NULL; |
---|
| 441 | |
---|
| 442 | return mpsr_Success; |
---|
| 443 | } |
---|
| 444 | |
---|
| 445 | mpsr_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); |
---|
[a9a7be] | 454 | |
---|
[0e1846] | 455 | n1 = gNvars + 1; |
---|
| 456 | if (nmon == 0) |
---|
| 457 | { |
---|
| 458 | p = NULL; |
---|
| 459 | return mpsr_Success; |
---|
| 460 | } |
---|
[a9a7be] | 461 | |
---|
[e78cce] | 462 | pp = pInit(); |
---|
[0e1846] | 463 | p = pp; |
---|
| 464 | failr(GetCoeff(link, &(pp->coef))); |
---|
| 465 | if (gNvars > 1) |
---|
| 466 | { |
---|
| 467 | mp_failr(IMP_GetSint32Vector(link, &gTa, n1)); |
---|
[427ba9] | 468 | pGetComp(pp) = gTa[0]; |
---|
| 469 | for (i=1; i<n1; i++) |
---|
| 470 | pSetExp(pp, i, (Exponent_t) gTa[i]); |
---|
[0e1846] | 471 | pSetm(pp); |
---|
| 472 | |
---|
| 473 | for (j=1; j<nmon; j++) |
---|
| 474 | { |
---|
[e78cce] | 475 | pp->next = pInit(); |
---|
[0e1846] | 476 | pp = pp->next; |
---|
| 477 | failr(GetCoeff(link, &(pp->coef))); |
---|
| 478 | mp_failr(IMP_GetSint32Vector(link, &gTa, n1)); |
---|
[427ba9] | 479 | pGetComp(pp) = gTa[0]; |
---|
| 480 | for (i=1; i<n1; i++) |
---|
| 481 | pSetExp(pp,i, (Exponent_t) gTa[i]); |
---|
[0e1846] | 482 | pSetm(pp); |
---|
| 483 | } |
---|
| 484 | } |
---|
| 485 | else |
---|
| 486 | { |
---|
| 487 | mp_failr(IMP_GetSint32(link, &i)); |
---|
[427ba9] | 488 | pGetComp(pp) = (Exponent_t) i; |
---|
[0e1846] | 489 | mp_failr(IMP_GetSint32(link, &i)); |
---|
[427ba9] | 490 | pSetExp(pp,1, (Exponent_t) i); |
---|
[0e1846] | 491 | pSetm(pp); |
---|
[a9a7be] | 492 | |
---|
[0e1846] | 493 | for (j=1; j<nmon; j++) |
---|
| 494 | { |
---|
[e78cce] | 495 | pp->next = pInit(); |
---|
[0e1846] | 496 | pp = pp->next; |
---|
| 497 | failr(GetCoeff(link, &(pp->coef))); |
---|
| 498 | mp_failr(IMP_GetSint32(link, &i)); |
---|
[427ba9] | 499 | pGetComp(pp) = (Exponent_t) i; |
---|
[0e1846] | 500 | mp_failr(IMP_GetSint32(link, &i)); |
---|
[427ba9] | 501 | pSetExp(pp,1, (Exponent_t) i); |
---|
[0e1846] | 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) \ |
---|
| 516 | do \ |
---|
| 517 | { \ |
---|
| 518 | if (!(x)) return mpsr_Failure; \ |
---|
| 519 | } \ |
---|
| 520 | while (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 |
---|
[a9a7be] | 526 | mpsr_Status_t mpsr_GetRingAnnots(MPT_Node_pt node, ring &r, |
---|
[12310e] | 527 | BOOLEAN &mv, BOOLEAN &IsUnOrdered) |
---|
[0e1846] | 528 | { |
---|
| 529 | sip_sring r1, *subring; |
---|
| 530 | poly minpoly = NULL; |
---|
| 531 | |
---|
| 532 | memset(&r1, 0, sizeof(sip_sring)); |
---|
| 533 | |
---|
| 534 | r = NULL; |
---|
[4a8d95] | 535 | if (MPT_Annot(node, MP_PolyDict, MP_AnnotPolyModuleVector) != NULL) |
---|
[0e1846] | 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 |
---|
[b7b08c] | 548 | r = (ring) AllocSizeOf(sip_sring); |
---|
[0e1846] | 549 | memcpy(r, &r1, sizeof(sip_sring)); |
---|
| 550 | |
---|
| 551 | if (GetVarNamesAnnot(node, r) != mpsr_Success) |
---|
| 552 | Warn("GetVarNamesAnnot: using default variable names"); |
---|
| 553 | |
---|
[12310e] | 554 | if (GetOrderingAnnot(node,r, mv, IsUnOrdered) != mpsr_Success) |
---|
[0e1846] | 555 | Warn("GetOrderingAnnot: using unspec ordering"); |
---|
| 556 | |
---|
[e06ef94] | 557 | rComplete(r); |
---|
| 558 | |
---|
[0e1846] | 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 | } |
---|
[e78cce] | 575 | |
---|
| 576 | // complete ring constructions |
---|
[0e1846] | 577 | return mpsr_Success; |
---|
| 578 | } |
---|
| 579 | |
---|
| 580 | |
---|
| 581 | static mpsr_Status_t GetVarNumberAnnot(MPT_Node_pt node, ring r, BOOLEAN mv) |
---|
| 582 | { |
---|
[4a8d95] | 583 | MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyVarNumber); |
---|
[0e1846] | 584 | |
---|
[a9a7be] | 585 | if (annot != NULL) |
---|
[0e1846] | 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 | |
---|
[a9a7be] | 598 | |
---|
[0e1846] | 599 | static mpsr_Status_t GetProtoTypeAnnot(MPT_Node_pt node, ring r, BOOLEAN mv, |
---|
[12310e] | 600 | ring &subring) |
---|
[0e1846] | 601 | { |
---|
| 602 | MPT_Annot_pt annot = NULL; |
---|
| 603 | MPT_Tree_pt val; |
---|
| 604 | MPT_Tree_pt *ta; |
---|
| 605 | |
---|
| 606 | subring = NULL; |
---|
[a9a7be] | 607 | |
---|
[0e1846] | 608 | // look for prototype annot |
---|
[4a8d95] | 609 | if ((val = MPT_ProtoAnnotValue(node)) == NULL) |
---|
[0e1846] | 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 |
---|
[a9a7be] | 627 | if (mv) |
---|
[0e1846] | 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 |
---|
[4a8d95] | 644 | if ((val = MPT_ProtoAnnotValue(node)) == NULL) |
---|
[0e1846] | 645 | return mpsr_Failure; |
---|
[a9a7be] | 646 | |
---|
[0e1846] | 647 | node = val->node; |
---|
[feaddd] | 648 | falser(NodeCheck(node, MP_CommonMetaType, MP_ProtoDict, MP_CmtProtoIMP_Sint32)); |
---|
[0e1846] | 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 |
---|
[a492d2] | 656 | if (MP_COMMON_T(node->nvalue) == MP_CmtNumberRational && |
---|
[0e1846] | 657 | node->dict == MP_NumberDict) |
---|
| 658 | { |
---|
| 659 | r->ch = 0; |
---|
| 660 | // Hmm ... we should check for the normalized annot |
---|
| 661 | } |
---|
[feaddd] | 662 | else if (MP_COMMON_T(node->nvalue) == MP_CmtProtoIMP_Uint32 && |
---|
[0e1846] | 663 | node->dict == MP_ProtoDict && |
---|
[4a8d95] | 664 | (annot = MPT_Annot(node,MP_NumberDict,MP_AnnotNumberModulos)) |
---|
[0e1846] | 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 | |
---|
[4a8d95] | 672 | if (MPT_Annot(annot->value->node, |
---|
[0e1846] | 673 | MP_NumberDict, MP_AnnotNumberIsPrime) == NULL) |
---|
| 674 | { |
---|
| 675 | // GF(p,n) |
---|
[4a8d95] | 676 | falser((annot = MPT_Annot(annot->value->node, 129, |
---|
[0e1846] | 677 | MP_AnnotSingularGalois)) != NULL && |
---|
| 678 | (annot->value != NULL) && |
---|
| 679 | (annot->value->node->type == MP_StringType)); |
---|
[b7b08c] | 680 | r->parameter = (char **)AllocSizeOf(char_ptr); |
---|
[0e1846] | 681 | r->parameter[0] = mstrdup(MP_STRING_T(annot->value->node->nvalue)); |
---|
| 682 | r->P = 1; |
---|
| 683 | } |
---|
| 684 | } |
---|
[feaddd] | 685 | else if (MP_COMMON_T(node->nvalue) == MP_CmtProtoIMP_Real32 && |
---|
[0e1846] | 686 | node->dict == MP_ProtoDict) |
---|
| 687 | { |
---|
| 688 | // floats |
---|
| 689 | r->ch = -1; |
---|
| 690 | } |
---|
| 691 | else |
---|
| 692 | return mpsr_SetError(mpsr_UnknownCoeffDomain); |
---|
[a9a7be] | 693 | |
---|
[0e1846] | 694 | return mpsr_Success; |
---|
| 695 | } |
---|
| 696 | else |
---|
| 697 | { |
---|
| 698 | // alg numbers |
---|
[12310e] | 699 | BOOLEAN mv2, IsUnOrdered; |
---|
[0e1846] | 700 | int i; |
---|
| 701 | |
---|
| 702 | // DDP Frac Node check |
---|
[5615cd9] | 703 | falser(NodeCheck(node, MP_CommonMetaOperatorType, MP_BasicDict, |
---|
| 704 | MP_CopBasicDiv) && |
---|
| 705 | node->numchild == 0); |
---|
[4a8d95] | 706 | falser((val = MPT_ProtoAnnotValue(node)) != NULL); |
---|
[5615cd9] | 707 | node = val->node; |
---|
| 708 | mpsr_assume(node != NULL); |
---|
[0e1846] | 709 | falser(NodeCheck(node, MP_CommonMetaOperatorType, MP_PolyDict, |
---|
[5615cd9] | 710 | MP_CopPolyDenseDistPoly) && |
---|
[0e1846] | 711 | node->numchild == 0); |
---|
| 712 | // GetRingAnnots |
---|
[12310e] | 713 | failr(mpsr_GetRingAnnots(node, subring, mv2, IsUnOrdered)); |
---|
[0e1846] | 714 | // Check whether the ring can be "coerced" to an algebraic number |
---|
[a9a7be] | 715 | falser( (rField_is_Zp(subring)||rField_is_Q(subring)) && |
---|
[be0d84] | 716 | // orig: subring->ch >= 0 &&a ??? |
---|
[0e1846] | 717 | subring->order[0] == ringorder_lp && |
---|
| 718 | subring->order[2] == 0 && |
---|
[12310e] | 719 | mv2 == FALSE && |
---|
| 720 | IsUnOrdered == FALSE); |
---|
[0e1846] | 721 | |
---|
| 722 | // Now do the coercion |
---|
[be0d84] | 723 | r->ch = (rField_is_Q(subring) ? 1 : - rChar(subring)); |
---|
[0e1846] | 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]); |
---|
[a9a7be] | 728 | |
---|
[0e1846] | 729 | // everything is ok |
---|
| 730 | return mpsr_Success; |
---|
| 731 | } |
---|
| 732 | } |
---|
| 733 | |
---|
| 734 | static mpsr_Status_t GetVarNamesAnnot(MPT_Node_pt node, ring r) |
---|
| 735 | { |
---|
[4a8d95] | 736 | MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyVarNames); |
---|
[0e1846] | 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 *)); |
---|
[a9a7be] | 742 | |
---|
[0e1846] | 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 | { |
---|
[4a8d95] | 750 | MPT_Tree_pt val = MPT_ProtoAnnotValue(node); |
---|
[0e1846] | 751 | if (val != NULL && |
---|
| 752 | NodeCheck(val->node, MP_CommonMetaType, MP_ProtoDict, |
---|
[feaddd] | 753 | MP_CmtProtoIMP_Identifier)) |
---|
[0e1846] | 754 | { |
---|
[a9a7be] | 755 | MPT_Arg_pt arg_pt = annot->value->args; |
---|
[0e1846] | 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 | |
---|
[a9a7be] | 787 | static mpsr_Status_t GetOrderingAnnot(MPT_Node_pt node, ring r, |
---|
[12310e] | 788 | BOOLEAN mv, BOOLEAN &IsUnOrdered) |
---|
[0e1846] | 789 | { |
---|
[a9a7be] | 790 | MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, |
---|
| 791 | MP_AnnotShouldHavePolyOrdering); |
---|
[12310e] | 792 | IsUnOrdered = FALSE; |
---|
[4a8d95] | 793 | mpsr_Status_t status = mpsr_Success; |
---|
| 794 | if (annot == NULL) |
---|
[12310e] | 795 | { |
---|
[4a8d95] | 796 | annot = MPT_Annot(node, MP_PolyDict,MP_AnnotPolyOrdering); |
---|
| 797 | if (annot == NULL) status = mpsr_Failure; |
---|
[12310e] | 798 | } |
---|
[4a8d95] | 799 | else |
---|
| 800 | { |
---|
| 801 | IsUnOrdered = TRUE; |
---|
| 802 | } |
---|
| 803 | |
---|
[0e1846] | 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 *)); |
---|
[a9a7be] | 818 | r->wvhdl = (int **) Alloc0(nc*sizeof(int *)); |
---|
[0e1846] | 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); |
---|
[a9a7be] | 858 | |
---|
[0e1846] | 859 | // Clean up if sth went wrong |
---|
| 860 | if (status == mpsr_Failure) |
---|
| 861 | { |
---|
| 862 | if (mv) nc++; |
---|
[4a8d95] | 863 | else nc += 2; |
---|
[0e1846] | 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 |
---|
[a9a7be] | 874 | r->wvhdl = (int **)Alloc0(3 * sizeof(int *)); |
---|
[0e1846] | 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); |
---|
[4a8d95] | 885 | |
---|
| 886 | if (status != mpsr_Success) |
---|
[12310e] | 887 | { |
---|
[0e1846] | 888 | r->order[0] = ringorder_unspec; |
---|
[4a8d95] | 889 | IsUnOrdered = FALSE; |
---|
[12310e] | 890 | } |
---|
[a9a7be] | 891 | |
---|
[0e1846] | 892 | return mpsr_rSetOrdSgn(r); |
---|
| 893 | } |
---|
| 894 | |
---|
| 895 | static mpsr_Status_t GetSimpleOrdering(MPT_Node_pt node, ring r, short i) |
---|
| 896 | { |
---|
| 897 | if (node->type != MP_CommonConstantType) |
---|
| 898 | return mpsr_Failure; |
---|
| 899 | |
---|
[4a8d95] | 900 | int sr_ord = mpsr_mp2ord(MP_COMMON_T(node->nvalue)); |
---|
[a9a7be] | 901 | |
---|
[4a8d95] | 902 | r->order[i] = sr_ord; |
---|
[0e1846] | 903 | if (r->order[i] == ringorder_unspec) return mpsr_Failure; |
---|
| 904 | |
---|
[4a8d95] | 905 | MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyWeights); |
---|
[0e1846] | 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, |
---|
[4a8d95] | 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) |
---|
[0e1846] | 926 | return mpsr_Failure; |
---|
| 927 | } |
---|
| 928 | |
---|
[a9a7be] | 929 | MPT_Annot_pt |
---|
[4a8d95] | 930 | annot2 = MPT_Annot(node, MP_ProtoDict, MP_AnnotProtoPrototype); |
---|
[0e1846] | 931 | |
---|
| 932 | if (annot2 == NULL || |
---|
| 933 | ! NodeCheck(annot2->value->node, MP_CommonMetaType, MP_ProtoDict, |
---|
[feaddd] | 934 | MP_CmtProtoIMP_Sint32)) |
---|
[0e1846] | 935 | return mpsr_Failure; |
---|
| 936 | |
---|
| 937 | MP_Uint32_t nc = node->numchild, j; |
---|
| 938 | MP_Sint32_t *w = (MP_Sint32_t *) annot->value->args; |
---|
[a9a7be] | 939 | int *w2 = (int *) AllocL(nc*sizeof(int)); |
---|
| 940 | |
---|
[0e1846] | 941 | r->wvhdl[i] = w2; |
---|
| 942 | for (j = 0; j < nc ; j++) |
---|
| 943 | w2[j] = w[j]; |
---|
| 944 | |
---|
| 945 | return mpsr_Success; |
---|
| 946 | } |
---|
| 947 | |
---|
| 948 | static mpsr_Status_t GetDefRelsAnnot(MPT_Node_pt node, ring r) |
---|
| 949 | { |
---|
[4a8d95] | 950 | MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict, MP_AnnotPolyDefRel); |
---|
[0e1846] | 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 | |
---|
[63374c] | 964 | if (! rEqual(r1, r)) return mpsr_Failure; |
---|
[0e1846] | 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; |
---|
[a9a7be] | 978 | |
---|
[0e1846] | 979 | return mpsr_Success; |
---|
| 980 | } |
---|
[a9a7be] | 981 | |
---|
[0e1846] | 982 | extern 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; |
---|
[a9a7be] | 1001 | int *matrix = r->wvhdl[i]; |
---|
| 1002 | |
---|
[0e1846] | 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 |
---|