[f6b5f0] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
[416465] | 4 | /* $Id: mpsr_Put.cc,v 1.19 1999-11-15 17:20:34 obachman Exp $ */ |
---|
[f6b5f0] | 5 | |
---|
[0e1846] | 6 | /*************************************************************** |
---|
| 7 | * |
---|
| 8 | * File: mpsr_Put.cc |
---|
| 9 | * Purpose: main put routines for MP connection to Singular |
---|
| 10 | * Author: Olaf Bachmann (10/95) |
---|
| 11 | * |
---|
| 12 | * Change History (most recent first): |
---|
| 13 | * o 1/97 obachman |
---|
[8a839d1] | 14 | * Updated putting routines to MP and MPP v1.1 |
---|
[0e1846] | 15 | * |
---|
| 16 | ***************************************************************/ |
---|
| 17 | #include "mod2.h" |
---|
| 18 | |
---|
| 19 | #ifdef HAVE_MPSR |
---|
| 20 | |
---|
| 21 | #include "mpsr_Put.h" |
---|
| 22 | #include "mpsr_Tok.h" |
---|
| 23 | #include "intvec.h" |
---|
| 24 | #include "lists.h" |
---|
| 25 | #include "numbers.h" |
---|
| 26 | #include "polys.h" |
---|
| 27 | #include "sing_mp.h" |
---|
| 28 | |
---|
| 29 | /*************************************************************** |
---|
| 30 | * |
---|
| 31 | * There are 4 different layers on which things are put: |
---|
| 32 | * 1.) Singular Top-level Data (chains of leftv's) == MP message |
---|
| 33 | * 2.) Single leftv's |
---|
| 34 | * 3.) Plain Singular data (different Singular data types) |
---|
| 35 | * 4.) Primitive polynomial Data |
---|
| 36 | * |
---|
| 37 | ***************************************************************/ |
---|
| 38 | |
---|
| 39 | /*************************************************************** |
---|
| 40 | * 1.) Routines for Top-level Data |
---|
| 41 | * |
---|
| 42 | ***************************************************************/ |
---|
| 43 | // this puts everything it finds in a leftv on the MP-link in form of |
---|
| 44 | // a message; Each leftv is sent as one MP Tree. The leftvs in a chain |
---|
| 45 | // of leftv's (i.e. for v->next != NULL) are sent as separate MP Trees |
---|
| 46 | // within the same MP message |
---|
| 47 | mpsr_Status_t mpsr_PutMsg(MP_Link_pt l, leftv v) |
---|
| 48 | { |
---|
| 49 | mpsr_Status_t status = mpsr_Success; |
---|
| 50 | |
---|
| 51 | MP_ResetLink(l); |
---|
| 52 | while (v != NULL && status == mpsr_Success) |
---|
| 53 | { |
---|
| 54 | status = mpsr_PutLeftv(l, v, currRing); |
---|
| 55 | v = v->next; |
---|
| 56 | } |
---|
| 57 | MP_EndMsg(l); |
---|
| 58 | |
---|
| 59 | return status; |
---|
| 60 | } |
---|
| 61 | |
---|
| 62 | |
---|
| 63 | /*************************************************************** |
---|
| 64 | * Second-level data routines |
---|
| 65 | * All the mpsr_Put*Leftv functions are defined as inline's in the header |
---|
| 66 | * |
---|
| 67 | ***************************************************************/ |
---|
| 68 | |
---|
| 69 | // This already depends on the ring |
---|
| 70 | mpsr_Status_t mpsr_PutLeftv(MP_Link_pt link, leftv v, ring cring) |
---|
| 71 | { |
---|
| 72 | idtyp type = v->Typ(); |
---|
| 73 | |
---|
| 74 | switch(type) |
---|
| 75 | { |
---|
| 76 | // first, all the ring-independent types |
---|
| 77 | case INT_CMD: |
---|
| 78 | return mpsr_PutIntLeftv(link,v); |
---|
| 79 | |
---|
| 80 | case INTVEC_CMD: |
---|
| 81 | return mpsr_PutIntVecLeftv(link, v); |
---|
| 82 | |
---|
| 83 | case INTMAT_CMD: |
---|
| 84 | return mpsr_PutIntMatLeftv(link, v); |
---|
| 85 | |
---|
| 86 | case STRING_CMD: |
---|
| 87 | return mpsr_PutStringLeftv(link, v); |
---|
| 88 | |
---|
| 89 | case RING_CMD: |
---|
| 90 | return mpsr_PutRingLeftv(link, v); |
---|
| 91 | |
---|
| 92 | case QRING_CMD: |
---|
| 93 | return mpsr_PutQRingLeftv(link, v); |
---|
| 94 | |
---|
| 95 | case PROC_CMD: |
---|
| 96 | return mpsr_PutProcLeftv(link, v); |
---|
| 97 | |
---|
| 98 | case DEF_CMD: |
---|
| 99 | return mpsr_PutDefLeftv(link, v); |
---|
| 100 | |
---|
[feaddd] | 101 | // now potentially ring-dependent types |
---|
[0e1846] | 102 | case LIST_CMD: |
---|
| 103 | return mpsr_PutListLeftv(link,v, cring); |
---|
| 104 | |
---|
| 105 | case COMMAND: |
---|
| 106 | return mpsr_PutCommandLeftv(link,v, cring); |
---|
| 107 | |
---|
| 108 | case NUMBER_CMD: |
---|
| 109 | return mpsr_PutNumberLeftv(link,v, cring); |
---|
| 110 | |
---|
| 111 | case POLY_CMD: |
---|
| 112 | return mpsr_PutPolyLeftv(link, v, cring); |
---|
| 113 | |
---|
| 114 | case IDEAL_CMD: |
---|
| 115 | return mpsr_PutIdealLeftv(link, v, cring); |
---|
| 116 | |
---|
| 117 | case VECTOR_CMD: |
---|
| 118 | return mpsr_PutVectorLeftv(link, v, cring); |
---|
| 119 | |
---|
| 120 | case MODUL_CMD: |
---|
| 121 | return mpsr_PutModuleLeftv(link, v, cring); |
---|
| 122 | |
---|
| 123 | case MATRIX_CMD: |
---|
| 124 | return mpsr_PutMatrixLeftv(link,v, cring); |
---|
| 125 | |
---|
| 126 | case MAP_CMD: |
---|
| 127 | return mpsr_PutMapLeftv(link, v, cring); |
---|
| 128 | |
---|
[0a3ddd] | 129 | case PACKAGE_CMD: |
---|
| 130 | return mpsr_PutPackageLeftv(link, v); |
---|
| 131 | |
---|
[cc0296] | 132 | case NONE: |
---|
| 133 | return mpsr_Success; |
---|
[8a839d1] | 134 | |
---|
[0e1846] | 135 | default: |
---|
| 136 | return mpsr_SetError(mpsr_UnknownLeftvType); |
---|
| 137 | } |
---|
| 138 | } |
---|
| 139 | |
---|
| 140 | /*************************************************************** |
---|
| 141 | * the Third-level data routines which are ring-independent |
---|
| 142 | * |
---|
| 143 | ***************************************************************/ |
---|
| 144 | mpsr_Status_t mpsr_PutIntVec(MP_Link_pt link, intvec *iv) |
---|
| 145 | { |
---|
| 146 | int length = iv->length(); |
---|
[8a839d1] | 147 | |
---|
| 148 | // Put the Vector Operator |
---|
[0e1846] | 149 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 150 | MP_MatrixDict, |
---|
| 151 | MP_CopMatrixDenseVector, |
---|
| 152 | 1, |
---|
| 153 | length)); |
---|
[8a839d1] | 154 | // Prototype Annot |
---|
[0e1846] | 155 | mp_failr(MP_PutAnnotationPacket(link, |
---|
| 156 | MP_ProtoDict, |
---|
[feaddd] | 157 | MP_AnnotProtoPrototype, |
---|
[0e1846] | 158 | MP_AnnotReqValNode)); |
---|
[feaddd] | 159 | // Together with the CommonMetaTypePacket specifying that each element of |
---|
[8a839d1] | 160 | // the vector is an Sint32 |
---|
[feaddd] | 161 | mp_failr(MP_PutCommonMetaTypePacket(link, |
---|
| 162 | MP_ProtoDict, |
---|
| 163 | MP_CmtProtoIMP_Sint32, |
---|
| 164 | 0)); |
---|
[8a839d1] | 165 | |
---|
| 166 | // Now we finally put the data |
---|
[0e1846] | 167 | mp_return(IMP_PutSint32Vector(link, (MP_Sint32_t *) iv->ivGetVec(), |
---|
| 168 | length)); |
---|
| 169 | } |
---|
| 170 | |
---|
| 171 | mpsr_Status_t mpsr_PutIntMat(MP_Link_pt link, intvec *iv) |
---|
| 172 | { |
---|
| 173 | int r = iv->rows(), c = iv->cols(), length = r*c; |
---|
| 174 | |
---|
[8a839d1] | 175 | // First, we put the Matrix operator |
---|
[0e1846] | 176 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 177 | MP_MatrixDict, |
---|
| 178 | MP_CopMatrixDenseMatrix, |
---|
| 179 | 2, |
---|
| 180 | length)); |
---|
[8a839d1] | 181 | // Put the two annotations |
---|
| 182 | // First, the prototype annot |
---|
[0e1846] | 183 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[feaddd] | 184 | MP_ProtoDict, |
---|
| 185 | MP_AnnotProtoPrototype, |
---|
| 186 | MP_AnnotReqValNode)); |
---|
| 187 | mp_failr(MP_PutCommonMetaTypePacket(link, |
---|
| 188 | MP_ProtoDict, |
---|
| 189 | MP_CmtProtoIMP_Sint32, |
---|
| 190 | 0)); |
---|
[8a839d1] | 191 | // And second, the dimension annot |
---|
[0e1846] | 192 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[feaddd] | 193 | MP_MatrixDict, |
---|
| 194 | MP_AnnotMatrixDimension, |
---|
| 195 | MP_AnnotReqValNode)); |
---|
[0e1846] | 196 | // which specifies the dimesnion of the matrix |
---|
| 197 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 198 | MP_BasicDict, |
---|
| 199 | MP_CopBasicList, |
---|
| 200 | 0, |
---|
| 201 | 2)); |
---|
[82dbf50] | 202 | mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) r, 0)); |
---|
| 203 | mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) c, 0)); |
---|
[0e1846] | 204 | |
---|
[8a839d1] | 205 | // And finally, we put the elments |
---|
[0e1846] | 206 | mp_return(IMP_PutSint32Vector(link, (MP_Sint32_t *) iv->ivGetVec(), |
---|
| 207 | length)); |
---|
| 208 | } |
---|
| 209 | |
---|
| 210 | mpsr_Status_t mpsr_PutRing(MP_Link_pt link, ring cring) |
---|
| 211 | { |
---|
| 212 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 213 | MP_PolyDict, |
---|
| 214 | MP_CopPolyRing, |
---|
| 215 | mpsr_GetNumOfRingAnnots(cring, 1), |
---|
| 216 | 0)); |
---|
[0e1846] | 217 | return mpsr_PutRingAnnots(link, cring, 1); |
---|
| 218 | } |
---|
| 219 | |
---|
[2ba9a6] | 220 | mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, procinfov proc) |
---|
[0e1846] | 221 | { |
---|
| 222 | MP_DictTag_t dict; |
---|
| 223 | MP_Common_t cop; |
---|
[2ba9a6] | 224 | char *iiGetLibProcBuffer(procinfov pi, int part=1); |
---|
[0e1846] | 225 | |
---|
| 226 | failr(mpsr_tok2mp('=', &dict, &cop)); |
---|
[8a839d1] | 227 | |
---|
[0e1846] | 228 | // A Singular- procedure is sent as a cop with the string as arg |
---|
| 229 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[8a839d1] | 230 | dict, |
---|
| 231 | cop, |
---|
| 232 | 0, |
---|
| 233 | 2)); |
---|
[feaddd] | 234 | mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1)); |
---|
| 235 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[8a839d1] | 236 | MP_SingularDict, |
---|
| 237 | MP_AnnotSingularProcDef, |
---|
| 238 | 0)); |
---|
[2ba9a6] | 239 | if( proc->language == LANG_SINGULAR) { |
---|
| 240 | if (proc->data.s.body == NULL) |
---|
| 241 | iiGetLibProcBuffer(proc); |
---|
| 242 | mp_return(MP_PutStringPacket(link, proc->data.s.body, 0)); |
---|
| 243 | } |
---|
| 244 | else |
---|
| 245 | mp_return(MP_PutStringPacket(link, "", 0)); |
---|
| 246 | mp_return(MP_Success); |
---|
[0e1846] | 247 | } |
---|
| 248 | |
---|
| 249 | |
---|
| 250 | /*************************************************************** |
---|
| 251 | * the Third-level data routines which are ring-dependent |
---|
| 252 | * |
---|
| 253 | ***************************************************************/ |
---|
| 254 | |
---|
| 255 | inline mpsr_Status_t PutLeftvChain(MP_Link_pt link, leftv lv, ring r) |
---|
| 256 | { |
---|
| 257 | while (lv != NULL) |
---|
| 258 | { |
---|
| 259 | failr(mpsr_PutLeftv(link, lv, r)); |
---|
| 260 | lv = lv->next; |
---|
| 261 | } |
---|
| 262 | return mpsr_Success; |
---|
| 263 | } |
---|
| 264 | |
---|
| 265 | mpsr_Status_t mpsr_PutList(MP_Link_pt link, lists l, ring cring) |
---|
| 266 | { |
---|
| 267 | int i, nl = l->nr + 1; |
---|
| 268 | |
---|
| 269 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 270 | MP_BasicDict, |
---|
| 271 | MP_CopBasicList, |
---|
| 272 | 0, |
---|
| 273 | nl)); |
---|
[0e1846] | 274 | for (i=0; i<nl; i++) |
---|
| 275 | failr(mpsr_PutLeftv(link, &(l->m[i]), cring)); |
---|
| 276 | |
---|
| 277 | return mpsr_Success; |
---|
| 278 | } |
---|
| 279 | |
---|
| 280 | mpsr_Status_t mpsr_PutCopCommand(MP_Link_pt link, command cmd, ring cring) |
---|
| 281 | { |
---|
| 282 | MP_Common_t cop; |
---|
| 283 | MP_DictTag_t dict; |
---|
| 284 | MP_NumChild_t nc = cmd->argc; |
---|
| 285 | leftv l; |
---|
| 286 | |
---|
| 287 | // First, we get the command cop -- at the moment, everything should be |
---|
| 288 | // a MP cop |
---|
| 289 | failr(mpsr_tok2mp(cmd->op, &dict, &cop)); |
---|
| 290 | |
---|
| 291 | // and put the common operator |
---|
[feaddd] | 292 | mp_failr(MP_PutCommonOperatorPacket(link, dict, cop, 0, nc)); |
---|
[0e1846] | 293 | |
---|
| 294 | // now we Put the arguments |
---|
| 295 | if (nc > 0) |
---|
| 296 | { |
---|
| 297 | if (nc <= 3) |
---|
| 298 | { |
---|
| 299 | failr(mpsr_PutLeftv(link, &(cmd->arg1), cring)); |
---|
| 300 | if (nc >1) |
---|
| 301 | { |
---|
| 302 | failr(mpsr_PutLeftv(link, &(cmd->arg2), cring)); |
---|
| 303 | if (nc == 3) return mpsr_PutLeftv(link, &(cmd->arg3), cring); |
---|
| 304 | else return mpsr_Success; |
---|
| 305 | } |
---|
| 306 | else return mpsr_Success; |
---|
| 307 | } |
---|
| 308 | else |
---|
| 309 | return PutLeftvChain(link, &(cmd->arg1), cring); |
---|
| 310 | } |
---|
| 311 | return mpsr_Success; |
---|
| 312 | } |
---|
| 313 | |
---|
| 314 | mpsr_Status_t mpsr_PutOpCommand(MP_Link_pt link, command cmd, ring cring) |
---|
| 315 | { |
---|
| 316 | mp_failr(MP_PutOperatorPacket(link, |
---|
[feaddd] | 317 | MP_SingularDict, |
---|
| 318 | (char *) (cmd->arg1.Data()), |
---|
| 319 | 0, |
---|
| 320 | (cmd->argc <= 1 ? 0 :(cmd->arg2).listLength()))); |
---|
[0e1846] | 321 | if (cmd->argc > 1) |
---|
| 322 | return PutLeftvChain(link, &(cmd->arg2), cring); |
---|
| 323 | else |
---|
| 324 | return mpsr_Success; |
---|
| 325 | } |
---|
| 326 | |
---|
| 327 | // Numbers are put as polys with one monomial and all exponents zero |
---|
| 328 | mpsr_Status_t mpsr_PutNumber(MP_Link_pt link, number n, ring cring) |
---|
| 329 | { |
---|
| 330 | ring rr = NULL; |
---|
| 331 | poly p = NULL; |
---|
| 332 | mpsr_Status_t r; |
---|
| 333 | |
---|
| 334 | if (currRing != cring) |
---|
| 335 | { |
---|
| 336 | rr = currRing; |
---|
| 337 | mpsr_SetCurrRing(cring, TRUE); |
---|
| 338 | } |
---|
[8a839d1] | 339 | |
---|
[0e1846] | 340 | if (!nIsZero(n)) |
---|
| 341 | { |
---|
| 342 | p = pOne(); |
---|
| 343 | pSetCoeff(p, nCopy(n)); |
---|
| 344 | } |
---|
| 345 | r = mpsr_PutPoly(link, p, cring); |
---|
| 346 | pDelete(&p); |
---|
| 347 | |
---|
| 348 | if (rr != NULL) mpsr_SetCurrRing(rr, TRUE); |
---|
[8a839d1] | 349 | |
---|
[0e1846] | 350 | return r; |
---|
| 351 | } |
---|
| 352 | |
---|
| 353 | mpsr_Status_t mpsr_PutPoly(MP_Link_pt link, poly p, ring cring) |
---|
| 354 | { |
---|
| 355 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 356 | MP_PolyDict, |
---|
| 357 | MP_CopPolyDenseDistPoly, |
---|
| 358 | mpsr_GetNumOfRingAnnots(cring, 0), |
---|
| 359 | pLength(p))); |
---|
[0e1846] | 360 | failr(mpsr_PutRingAnnots(link, cring, 0)); |
---|
| 361 | return mpsr_PutPolyData(link, p, cring); |
---|
| 362 | } |
---|
| 363 | |
---|
| 364 | |
---|
| 365 | mpsr_Status_t mpsr_PutPolyVector(MP_Link_pt link, poly p, ring cring) |
---|
| 366 | { |
---|
| 367 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 368 | MP_PolyDict, |
---|
| 369 | MP_CopPolyDenseDistPoly, |
---|
| 370 | mpsr_GetNumOfRingAnnots(cring,1), |
---|
| 371 | pLength(p))); |
---|
[0e1846] | 372 | failr(mpsr_PutRingAnnots(link, cring, 1)); |
---|
| 373 | return mpsr_PutPolyVectorData(link, p, cring); |
---|
| 374 | } |
---|
| 375 | |
---|
| 376 | |
---|
| 377 | mpsr_Status_t mpsr_PutIdeal(MP_Link_pt link, ideal id, ring cring) |
---|
| 378 | { |
---|
| 379 | int i, idn = IDELEMS(id); |
---|
| 380 | |
---|
| 381 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 382 | MP_PolyDict, |
---|
| 383 | MP_CopPolyIdeal, |
---|
| 384 | 1, |
---|
| 385 | idn)); |
---|
[0e1846] | 386 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[feaddd] | 387 | MP_ProtoDict, |
---|
| 388 | MP_AnnotProtoPrototype, |
---|
| 389 | MP_AnnotReqValNode)); |
---|
[0e1846] | 390 | mp_failr(MP_PutCommonMetaOperatorPacket(link, |
---|
[feaddd] | 391 | MP_PolyDict, |
---|
| 392 | MP_CopPolyDenseDistPoly, |
---|
| 393 | mpsr_GetNumOfRingAnnots(cring, 0), |
---|
| 394 | 0)); |
---|
[0e1846] | 395 | failr(mpsr_PutRingAnnots(link, cring, 0)); |
---|
| 396 | |
---|
| 397 | for (i=0; i < idn; i++) |
---|
| 398 | { |
---|
| 399 | IMP_PutUint32(link, pLength(id->m[i])); |
---|
| 400 | failr(mpsr_PutPolyData(link, id->m[i], cring)); |
---|
| 401 | } |
---|
| 402 | return mpsr_Success; |
---|
| 403 | } |
---|
| 404 | |
---|
| 405 | mpsr_Status_t mpsr_PutModule(MP_Link_pt link, ideal id, ring cring) |
---|
| 406 | { |
---|
| 407 | int i, idn = IDELEMS(id); |
---|
| 408 | |
---|
| 409 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 410 | MP_PolyDict, |
---|
| 411 | MP_CopPolyModule, |
---|
[e51e9b] | 412 | 2, |
---|
[feaddd] | 413 | idn)); |
---|
[0e1846] | 414 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[feaddd] | 415 | MP_ProtoDict, |
---|
| 416 | MP_AnnotProtoPrototype, |
---|
| 417 | MP_AnnotReqValNode)); |
---|
[0e1846] | 418 | mp_failr(MP_PutCommonMetaOperatorPacket(link, |
---|
[feaddd] | 419 | MP_PolyDict, |
---|
| 420 | MP_CopPolyDenseDistPoly, |
---|
| 421 | mpsr_GetNumOfRingAnnots(cring, 1), |
---|
| 422 | 0)); |
---|
[0e1846] | 423 | failr(mpsr_PutRingAnnots(link, cring, 1)); |
---|
[8a839d1] | 424 | |
---|
[e51e9b] | 425 | mp_failr(MP_PutAnnotationPacket(link, |
---|
| 426 | MP_PolyDict, |
---|
| 427 | MP_AnnotPolyModuleRank, |
---|
| 428 | MP_AnnotValuated)); |
---|
| 429 | mp_failr(MP_PutUint32Packet(link, id->rank, 0)); |
---|
[8a839d1] | 430 | |
---|
[0e1846] | 431 | for (i=0; i < idn; i++) |
---|
| 432 | { |
---|
| 433 | IMP_PutUint32(link, pLength(id->m[i])); |
---|
| 434 | failr(mpsr_PutPolyVectorData(link, id->m[i], cring)); |
---|
| 435 | } |
---|
| 436 | return mpsr_Success; |
---|
| 437 | } |
---|
| 438 | |
---|
| 439 | mpsr_Status_t mpsr_PutMatrix(MP_Link_pt link, ideal id, ring cring) |
---|
| 440 | { |
---|
| 441 | int nrows = id->nrows, ncols = id->ncols; |
---|
| 442 | MP_Uint32_t n = nrows*ncols, i; |
---|
| 443 | |
---|
[8a839d1] | 444 | // First, we put the Matrix operator |
---|
[0e1846] | 445 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 446 | MP_MatrixDict, |
---|
| 447 | MP_CopMatrixDenseMatrix, |
---|
| 448 | 2, |
---|
| 449 | n)); |
---|
[8a839d1] | 450 | // Put the two annotations |
---|
| 451 | // First, the prototype annot |
---|
[0e1846] | 452 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[feaddd] | 453 | MP_ProtoDict, |
---|
| 454 | MP_AnnotProtoPrototype, |
---|
| 455 | MP_AnnotReqValNode)); |
---|
[0e1846] | 456 | mp_failr(MP_PutCommonMetaOperatorPacket(link, |
---|
[feaddd] | 457 | MP_PolyDict, |
---|
| 458 | MP_CopPolyDenseDistPoly, |
---|
| 459 | mpsr_GetNumOfRingAnnots(cring, 0), |
---|
| 460 | 0)); |
---|
[0e1846] | 461 | failr(mpsr_PutRingAnnots(link, cring, 0)); |
---|
| 462 | |
---|
| 463 | // second, the matrix dim annot |
---|
| 464 | mp_failr(MP_PutAnnotationPacket(link, |
---|
[feaddd] | 465 | MP_MatrixDict, |
---|
| 466 | MP_AnnotMatrixDimension, |
---|
| 467 | MP_AnnotReqValNode)); |
---|
[0e1846] | 468 | // which specifies the dimesnion of the matrix |
---|
| 469 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 470 | MP_BasicDict, |
---|
| 471 | MP_CopBasicList, |
---|
| 472 | 0, 2)); |
---|
[82dbf50] | 473 | mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) nrows, 0)); |
---|
| 474 | mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) ncols, 0)); |
---|
[0e1846] | 475 | |
---|
[8a839d1] | 476 | // And finally, we put the elments |
---|
[0e1846] | 477 | for (i=0; i < n; i++) |
---|
| 478 | { |
---|
| 479 | IMP_PutUint32(link, pLength(id->m[i])); |
---|
| 480 | failr(mpsr_PutPolyData(link, id->m[i], cring)); |
---|
| 481 | } |
---|
| 482 | return mpsr_Success; |
---|
| 483 | } |
---|
| 484 | |
---|
| 485 | |
---|
| 486 | // We communicate a map as an operator having three arguments: A ring, |
---|
| 487 | // its name and an ideal |
---|
| 488 | mpsr_Status_t mpsr_PutMap(MP_Link_pt link, map m, ring cring) |
---|
| 489 | { |
---|
| 490 | MP_Uint32_t i, idn = IDELEMS((ideal) m); |
---|
| 491 | MP_DictTag_t dict; |
---|
| 492 | MP_Common_t cop; |
---|
| 493 | |
---|
| 494 | failr(mpsr_tok2mp(MAP_CMD, &dict, &cop)); |
---|
| 495 | |
---|
| 496 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[feaddd] | 497 | dict, |
---|
| 498 | cop, |
---|
| 499 | 0, |
---|
| 500 | 3)); |
---|
[0e1846] | 501 | // First, is the ring |
---|
[46d09b] | 502 | #ifdef HAVE_NAMESPACES |
---|
| 503 | failr(mpsr_PutRingLeftv(link, (leftv) namespaceroot->get(m->preimage, 1))); |
---|
| 504 | #else /* HAVE_NAMESPACES */ |
---|
[0e1846] | 505 | failr(mpsr_PutRingLeftv(link, (leftv) idroot->get(m->preimage, 1))); |
---|
[46d09b] | 506 | #endif /* HAVE_NAMESPACES */ |
---|
[0e1846] | 507 | |
---|
| 508 | // Second, the name of the ring |
---|
| 509 | mp_failr(MP_PutStringPacket(link, m->preimage,0)); |
---|
[8a839d1] | 510 | |
---|
[0e1846] | 511 | // and third, the ideal -- |
---|
| 512 | // supposing that we can cast a map to an ideal |
---|
| 513 | return mpsr_PutIdeal(link, (ideal) m, cring); |
---|
| 514 | } |
---|
| 515 | |
---|
[fff984] | 516 | mpsr_Status_t mpsr_PutPackage(MP_Link_pt link, package pack) |
---|
[0a3ddd] | 517 | { |
---|
| 518 | MP_DictTag_t dict; |
---|
| 519 | MP_Common_t cop; |
---|
| 520 | |
---|
[fff984] | 521 | failr(mpsr_tok2mp(PACKAGE_CMD, &dict, &cop)); |
---|
[0a3ddd] | 522 | |
---|
| 523 | // A Singular- procedure is sent as a cop with the string as arg |
---|
| 524 | mp_failr(MP_PutCommonOperatorPacket(link, |
---|
[fff984] | 525 | dict, |
---|
| 526 | cop, |
---|
| 527 | 1, |
---|
| 528 | (pack->language != LANG_NONE && |
---|
| 529 | pack->language != LANG_TOP ? 1 : 0))); |
---|
[0a3ddd] | 530 | mp_failr(MP_PutAnnotationPacket(link, |
---|
| 531 | MP_SingularDict, |
---|
[fff984] | 532 | MP_AnnotSingularPackageType, |
---|
| 533 | MP_AnnotValuated)); |
---|
| 534 | mp_failr(MP_PutUint8Packet(link, (unsigned char) pack->language, 0)); |
---|
| 535 | if (pack->language != LANG_NONE && pack->language != LANG_TOP) |
---|
| 536 | { |
---|
| 537 | assume(pack->libname != NULL); |
---|
| 538 | mp_failr(MP_PutStringPacket(link, pack->libname, 0)); |
---|
| 539 | } |
---|
[0a3ddd] | 540 | mp_return(MP_Success); |
---|
| 541 | } |
---|
| 542 | |
---|
[0e1846] | 543 | /*************************************************************** |
---|
[8a839d1] | 544 | * |
---|
[0e1846] | 545 | * A routine which dumps the content of Singular to a file |
---|
| 546 | * |
---|
| 547 | ***************************************************************/ |
---|
[286bd57] | 548 | mpsr_Status_t mpsr_PutDump(MP_Link_pt link) |
---|
[0e1846] | 549 | { |
---|
[46d09b] | 550 | idhdl h = IDROOT, h2 = NULL, rh = currRingHdl; |
---|
[0e1846] | 551 | ring r; |
---|
| 552 | sip_command cmd; |
---|
| 553 | leftv lv; |
---|
[a9a7be] | 554 | |
---|
[0e1846] | 555 | mpsr_ClearError(); |
---|
| 556 | memset(&(cmd), 0, sizeof(sip_command)); |
---|
| 557 | cmd.argc = 2; |
---|
| 558 | cmd.op = '='; |
---|
| 559 | cmd.arg1.rtyp = DEF_CMD; |
---|
| 560 | lv = mpsr_InitLeftv(COMMAND, (void *) &cmd); |
---|
[8a839d1] | 561 | |
---|
[0e1846] | 562 | MP_ResetLink(link); |
---|
| 563 | while (h != NULL && h2 == NULL) |
---|
| 564 | { |
---|
[8a839d1] | 565 | |
---|
[0e1846] | 566 | if (IDTYP(h) == PROC_CMD) |
---|
| 567 | { |
---|
| 568 | failr(mpsr_PutLeftv(link, (leftv) h, NULL)); |
---|
| 569 | #ifdef MPSR_DEBUG |
---|
| 570 | Print("Dumped Proc %s\n", IDID(h)); |
---|
| 571 | #endif |
---|
| 572 | } |
---|
[fff984] | 573 | // do not dump LIB string and Links and Top PACKAGE |
---|
[97454d] | 574 | else if (!(IDTYP(h) == STRING_CMD && strcmp("LIB", IDID(h)) == 0) && |
---|
[a9a7be] | 575 | IDTYP(h) != LINK_CMD && |
---|
[fff984] | 576 | ! (IDTYP(h) == PACKAGE_CMD && strcmp(IDID(h), "Top") == 0)) |
---|
[0e1846] | 577 | { |
---|
[fff984] | 578 | #ifdef HAVE_NAMESPACES |
---|
[a9a7be] | 579 | cmd.arg1.name = (char*) |
---|
[fff984] | 580 | AllocL(strlen(IDID(h)) + strlen(namespaceroot->name) + 3); |
---|
| 581 | sprintf(cmd.arg1.name, "%s::%s", namespaceroot->name, IDID(h)); |
---|
| 582 | #else |
---|
[0e1846] | 583 | cmd.arg1.name = IDID(h); |
---|
[a9a7be] | 584 | #endif |
---|
[b379ce] | 585 | cmd.arg2.data=IDDATA(h); |
---|
| 586 | cmd.arg2.flag=h->flag; |
---|
| 587 | cmd.arg2.attribute=h->attribute; |
---|
| 588 | cmd.arg2.rtyp=h->typ; |
---|
[fff984] | 589 | #ifdef HAVE_NAMESPACES |
---|
[a9a7be] | 590 | if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success) |
---|
[fff984] | 591 | { |
---|
| 592 | FreeL(cmd.arg1.name); |
---|
| 593 | break; |
---|
| 594 | } |
---|
| 595 | FreeL(cmd.arg1.name); |
---|
| 596 | #else |
---|
| 597 | if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break; |
---|
| 598 | #endif |
---|
[a9a7be] | 599 | |
---|
[0e1846] | 600 | #ifdef MPSR_DEBUG |
---|
| 601 | Print("Dumped %s\n", IDID(h)); |
---|
| 602 | #endif |
---|
[a9a7be] | 603 | if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD || |
---|
[fff984] | 604 | (IDTYP(h) == PACKAGE_CMD && strcmp(IDID(h), "Top") != 0)) |
---|
[0e1846] | 605 | { |
---|
| 606 | // we don't really need to do that, it's only for convenience |
---|
| 607 | // for putting numbers |
---|
[fff984] | 608 | if (IDTYP(h) == PACKAGE_CMD) |
---|
| 609 | { |
---|
| 610 | namespaceroot->push(IDPACKAGE(h), IDID(h)); |
---|
| 611 | h2 = IDPACKAGE(h)->idroot; |
---|
| 612 | } |
---|
| 613 | else |
---|
| 614 | { |
---|
| 615 | rSetHdl(h, TRUE); |
---|
| 616 | r = IDRING(h); |
---|
| 617 | h2 = r->idroot; |
---|
| 618 | } |
---|
[0e1846] | 619 | while (h2 != NULL) |
---|
| 620 | { |
---|
[fff984] | 621 | #ifdef HAVE_NAMESPACES |
---|
[a9a7be] | 622 | cmd.arg1.name = (char*) |
---|
[fff984] | 623 | AllocL(strlen(IDID(h2)) + strlen(namespaceroot->name) + 3); |
---|
| 624 | sprintf(cmd.arg1.name, "%s::%s", namespaceroot->name, IDID(h2)); |
---|
| 625 | #else |
---|
[0e1846] | 626 | cmd.arg1.name = IDID(h2); |
---|
[a9a7be] | 627 | #endif |
---|
[8a839d1] | 628 | cmd.arg2.data=IDDATA(h2); |
---|
[0a3ddd] | 629 | cmd.arg2.flag = h2->flag; |
---|
| 630 | cmd.arg2.attribute = h2->attribute; |
---|
| 631 | cmd.arg2.rtyp = h2->typ; |
---|
[fff984] | 632 | #ifdef HAVE_NAMESPACES |
---|
[a9a7be] | 633 | if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success) |
---|
[fff984] | 634 | { |
---|
| 635 | FreeL(cmd.arg1.name); |
---|
| 636 | break; |
---|
| 637 | } |
---|
| 638 | FreeL(cmd.arg1.name); |
---|
| 639 | #else |
---|
[0e1846] | 640 | if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break; |
---|
[fff984] | 641 | #endif |
---|
[0e1846] | 642 | #ifdef MPSR_DEBUG |
---|
[feaddd] | 643 | Print("Dumped %s\n", IDID(h2)); |
---|
[0e1846] | 644 | #endif |
---|
| 645 | h2 = h2->next; |
---|
| 646 | } |
---|
[fff984] | 647 | if (IDTYP(h) == PACKAGE_CMD) |
---|
| 648 | { |
---|
| 649 | namespaceroot->pop(); |
---|
| 650 | } |
---|
[0e1846] | 651 | } |
---|
| 652 | } |
---|
[8a839d1] | 653 | |
---|
[0e1846] | 654 | h = h->next; |
---|
| 655 | } |
---|
| 656 | MP_EndMsg(link); |
---|
[b7b08c] | 657 | FreeSizeOf(lv, sleftv); |
---|
[0e1846] | 658 | if (rh != NULL && rh != currRingHdl) rSetHdl(rh, TRUE); |
---|
[8a839d1] | 659 | |
---|
[0e1846] | 660 | if (h == NULL && h2 == NULL) |
---|
[286bd57] | 661 | return mpsr_Success; |
---|
[0e1846] | 662 | else |
---|
[286bd57] | 663 | return mpsr_Failure; |
---|
[0e1846] | 664 | } |
---|
[8a839d1] | 665 | |
---|
[0e1846] | 666 | #endif // HAVE_MPSR |
---|
| 667 | |
---|
| 668 | |
---|