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