Annotation of OpenXM/src/ox_maple/m2c.c, Revision 1.1
1.1 ! iwane 1: /* $OpenXM$ */
! 2: /************************************************************************
! 3: * MapleObject --> CMO converter
! 4: *
! 5: *********************************************************************** */
! 6: #include "oxmaple.h"
! 7: #include "maplec.h"
! 8:
! 9: /*==========================================================================*
! 10: * Block interrupt input
! 11: *==========================================================================*/
! 12:
! 13: /*
! 14: #define BLOCK_NEW_CMO() BLOCK_INPUT()
! 15: #define UNBLOCK_NEW_CMO() UNBLOCK_INPUT()
! 16: */
! 17:
! 18: #define BLOCK_NEW_CMO()
! 19: #define UNBLOCK_NEW_CMO()
! 20:
! 21: #define DPRINTF(x) printf x; fflush(stdout)
! 22:
! 23: char *
! 24: convert_maple2str(MKernelVector kv, ALGEB alg)
! 25: {
! 26: ALGEB s;
! 27: char *str;
! 28: s = MapleALGEB_SPrintf(kv, "%a", alg);
! 29: str = MapleToString(kv, s);
! 30: return (str);
! 31: }
! 32:
! 33: cmo *
! 34: conv_num2cmo(MKernelVector kv, ALGEB alg)
! 35: {
! 36: int n;
! 37: char buf[124];
! 38: ALGEB s;
! 39:
! 40: /* $B$I!<$b(B asir $B$N(B CMO_INT32 $B$OIi$N?t$KBP1~$7$F$$$J$$MM;R(B */
! 41: if (IsMapleInteger16(kv, alg)) {
! 42: n = MapleToInteger16(kv, alg);
! 43: return ((cmo *)new_cmo_zz_set_si(n));
! 44: /* return ((cmo *)new_cmo_int32(n)); */
! 45: } else if (IsMapleInteger32(kv, alg)) {
! 46: n = MapleToInteger32(kv, alg);
! 47: return ((cmo *)new_cmo_zz_set_si(n));
! 48: /* return ((cmo *)new_cmo_int32(n)); */
! 49: } else if (IsMapleInteger(kv, alg)) {
! 50: mpz_ptr z = MapleToGMPInteger(kv, alg);
! 51: cmo_zz *c = new_cmo_zz_set_mpz(z);
! 52: return ((cmo *)c);
! 53:
! 54: }
! 55:
! 56: #if 1
! 57: else if (IsMapleAssignedName(kv, alg)) { DPRINTF(("maple IsMapleAssignedName @ conv_num2cmo\n")); }
! 58: else if (IsMapleComplexNumeric(kv, alg)) { DPRINTF(("maple IsMapleComplexNumeric @ conv_num2cmo\n")); }
! 59: else if (IsMapleInteger(kv, alg)) { DPRINTF(("maple IsMapleInteger @ conv_num2cmo\n")); }
! 60: else if (IsMapleInteger16(kv, alg)) { DPRINTF(("maple IsMapleInteger16 @ conv_num2cmo\n")); }
! 61: else if (IsMapleInteger32(kv, alg)) { DPRINTF(("maple IsMapleInteger32 @ conv_num2cmo\n")); }
! 62: else if (IsMapleInteger64(kv, alg)) { DPRINTF(("maple IsMapleInteger64 @ conv_num2cmo\n")); }
! 63: else if (IsMapleInteger8(kv, alg)) { DPRINTF(("maple IsMapleInteger8 @ conv_num2cmo\n")); }
! 64: else if (IsMapleList(kv, alg)) { DPRINTF(("maple IsMapleList @ conv_num2cmo\n")); }
! 65: else if (IsMapleName(kv, alg)) { DPRINTF(("maple IsMapleName @ conv_num2cmo\n")); }
! 66: else if (IsMapleNULL(kv, alg)) { DPRINTF(("maple IsMapleNULL @ conv_num2cmo\n")); }
! 67: else if (IsMaplePointer(kv, alg)) { DPRINTF(("maple IsMaplePointer @ conv_num2cmo\n")); }
! 68: else if (IsMaplePointerNULL(kv, alg)) { DPRINTF(("maple IsMaplePointerNULL @ conv_num2cmo\n")); }
! 69: else if (IsMapleProcedure(kv, alg)) { DPRINTF(("maple IsMapleProcedure @ conv_num2cmo\n")); }
! 70: else if (IsMapleRTable(kv, alg)) { DPRINTF(("maple IsMapleRTable @ conv_num2cmo\n")); }
! 71: else if (IsMapleSet(kv, alg)) { DPRINTF(("maple IsMapleSet @ conv_num2cmo\n")); }
! 72: else if (IsMapleStop(kv, alg)) { DPRINTF(("maple IsMapleStop @ conv_num2cmo\n")); }
! 73: else if (IsMapleString(kv, alg)) { DPRINTF(("maple IsMapleString @ conv_num2cmo\n")); }
! 74: else if (IsMapleTable(kv, alg)) { DPRINTF(("maple IsMapleTable @ conv_num2cmo\n")); }
! 75: else if (IsMapleUnassignedName(kv, alg)) { DPRINTF(("maple IsMapleUnassignedName @ conv_num2cmo\n")); }
! 76: else if (IsMapleUnnamedZero(kv, alg)) { DPRINTF(("maple IsMapleUnnamedZero @ conv_num2cmo\n")); }
! 77: #endif
! 78:
! 79: DPRINTF(("maple unknown @ convert_conv_num2cmo \n"));
! 80:
! 81:
! 82: s = ToMapleName(kv, "tmp", TRUE);
! 83: MapleAssign(kv, s, alg);
! 84:
! 85: sprintf(buf, "type(tmp, rational):");
! 86: s = EvalMapleStatement(kv, buf);
! 87: if (MapleToInteger32(kv, s)) {
! 88: mpz_ptr p1, p2;
! 89: cmo_qq *q;
! 90:
! 91: sprintf(buf, "numer(tmp):");
! 92: p1 = MapleToGMPInteger(kv, EvalMapleStatement(kv, buf));
! 93:
! 94: sprintf(buf, "denom(tmp):");
! 95: p2 = MapleToGMPInteger(kv, EvalMapleStatement(kv, buf));
! 96:
! 97: q = new_cmo_qq_set_mpz(p1, p2);
! 98: return ((cmo *)q);
! 99: }
! 100:
! 101:
! 102: /* float @@TODO */
! 103:
! 104: printf("unknown type found. return NULL.\n");
! 105:
! 106: return NULL;
! 107: }
! 108:
! 109:
! 110: static cmo_polynomial_in_one_variable *
! 111: conv_1poly2cmo(MKernelVector kv, const char *f, cell *cl, int lv, char *buf)
! 112: {
! 113: char buf2[10];
! 114: int i, deg;
! 115: ALGEB s;
! 116: cmo *cm;
! 117: cmo_polynomial_in_one_variable *poly;
! 118: const char *x;
! 119:
! 120:
! 121: cm = cl->cmo; /* indeterminate */
! 122: cm = ((cmo_indeterminate *)cm)->ob; /* string */
! 123: x = ((cmo_string *)cm)->s;
! 124:
! 125: sprintf(buf, "degree(%s,%s):", f, x);
! 126: s = EvalMapleStatement(kv, buf);
! 127: deg = MapleToInteger32(kv, s);
! 128: if (deg < 0) {
! 129: return (conv_1poly2cmo(kv, f, cl->next, lv + 1, buf));
! 130: }
! 131:
! 132: poly = new_cmo_polynomial_in_one_variable(lv);
! 133: for (i = deg; i >= 0; i--) {
! 134: sprintf(buf, "%s_%d:=coeff(%s,%s,%d):", f, lv, f, x, i);
! 135: s = EvalMapleStatement(kv, buf);
! 136: if (!IsMapleUnnamedZero(kv, s)) {
! 137: if (IsMapleNumeric(kv, s)) {
! 138: cm = conv_num2cmo(kv, s);
! 139: } else {
! 140: sprintf(buf2, "%s_%d", f, lv);
! 141: cm = (cmo *)conv_1poly2cmo(kv, buf2, cl->next, lv + 1, buf);
! 142: }
! 143: if (cm == NULL) {
! 144: return (NULL);
! 145: }
! 146: list_append_monomial((cmo_list *)poly, cm, i);
! 147: }
! 148: }
! 149:
! 150: return (poly);
! 151: }
! 152:
! 153: static cmo *
! 154: conv_matrix2cmo(MKernelVector kv, const char *f)
! 155: {
! 156: char buf[100];
! 157: int row;
! 158: int col;
! 159: int i, j;
! 160: cmo_list *list;
! 161:
! 162: ALGEB s;
! 163:
! 164:
! 165: sprintf(buf, "LinearAlgebra[RowDimension](%s):", f);
! 166: s = EvalMapleStatement(kv, buf);
! 167: row = MapleToInteger32(kv, s);
! 168:
! 169: sprintf(buf, "LinearAlgebra[ColumnDimension](%s):", f);
! 170: s = EvalMapleStatement(kv, buf);
! 171: col = MapleToInteger32(kv, s);
! 172:
! 173:
! 174: list = new_cmo_list();
! 175: list_append(list, (cmo *)new_cmo_int32(row));
! 176: list_append(list, (cmo *)new_cmo_int32(col));
! 177:
! 178: /* RTableSelect $B$r;H$&$Y$-$+(B @@TODO */
! 179: for (i = 1; i <= row; i++) {
! 180: for (j = 1; j <= col; j++) {
! 181: sprintf(buf, "%s[%d,%d]:", f, i, j);
! 182: s = EvalMapleStatement(kv, buf);
! 183: list_append(list, convert_maple2cmo(kv, s));
! 184: }
! 185: }
! 186:
! 187: return ((cmo *)list);
! 188: }
! 189:
! 190: static cmo *
! 191: conv_poly2cmo(MKernelVector kv, const char *f)
! 192: {
! 193: ALGEB s, s2;
! 194: char buf[100];
! 195:
! 196: cmo_recursive_polynomial *rec;
! 197: cmo_polynomial_in_one_variable *poly;
! 198:
! 199: cmo_list *ringdef;
! 200: int i;
! 201: int varn;
! 202: cell *cl;
! 203:
! 204: char *x;
! 205:
! 206: sprintf(buf, "%s_n := indets(%s):", f, f);
! 207: s = EvalMapleStatement(kv, buf);
! 208:
! 209: sprintf(buf, "nops(%s_n):", f);
! 210: s2 = EvalMapleStatement(kv, buf);
! 211:
! 212: varn = MapleToInteger32(kv, s2);
! 213:
! 214: BLOCK_NEW_CMO();
! 215: ringdef = new_cmo_list();
! 216: for (i = 1; i <= varn; i++) {
! 217: cmo_indeterminate *xc;
! 218: sprintf(buf, "%s_n[%d]:", f, i);
! 219: s = EvalMapleStatement(kv, buf);
! 220: x = MapleToString(kv, s);
! 221: xc = new_cmo_indeterminate((cmo *)new_cmo_string(x));
! 222: list_append(ringdef, (cmo *)xc);
! 223: }
! 224:
! 225: cl = ringdef->head->next;
! 226: poly = conv_1poly2cmo(kv, f, cl, 0, buf);
! 227:
! 228: rec = new_cmo_recursive_polynomial(ringdef, (cmo *)poly);
! 229: UNBLOCK_NEW_CMO();
! 230:
! 231: if (poly == NULL) {
! 232: return (NULL);
! 233: }
! 234:
! 235: return ((cmo *)rec);
! 236: }
! 237:
! 238: static cmo *
! 239: conv_list2cmo(MKernelVector kv, ALGEB alg)
! 240: {
! 241: int i, n;
! 242: ALGEB s;
! 243: char *str;
! 244: cmo_list *list;
! 245: cmo *c;
! 246:
! 247: s = MapleALGEB_SPrintf(kv, "nops(%a):", alg);
! 248: str = MapleToString(kv, s);
! 249: n = MapleToInteger32(kv, EvalMapleStatement(kv, str));
! 250:
! 251:
! 252: list = new_cmo_list();
! 253: for (i = 1; i <= n; i++) {
! 254: s = MapleListSelect(kv, alg, i);
! 255: c = convert_maple2cmo(kv, s);
! 256: if (c == NULL) {
! 257: list = NULL;
! 258: break;
! 259: }
! 260: list_append(list, c);
! 261: }
! 262: return ((cmo *)list);
! 263: }
! 264:
! 265:
! 266: cmo *
! 267: convert_maple2cmo(MKernelVector kv, ALGEB alg)
! 268: {
! 269: if (IsMapleNumeric(kv, alg)) {
! 270: return (conv_num2cmo(kv, alg));
! 271:
! 272: } else if (IsMapleString(kv, alg)) {
! 273: DPRINTF(("maplestring @ convert_maple2cmo\n"));
! 274: char *str = MapleToString(kv, alg);
! 275: return ((cmo *)new_cmo_string(str));
! 276: } else if (IsMapleExpressionSequence(kv, alg)) {
! 277: DPRINTF(("mapleexpress@ convert_maple2cmo\n"));
! 278:
! 279: } else if (IsMapleAssignedName(kv, alg)) {
! 280: DPRINTF(("maple assigned name@ convert_maple2cmo\n"));
! 281:
! 282: } else if (IsMapleProcedure(kv, alg)) {
! 283: DPRINTF(("maple procedure @ convert_maple2cmo\n"));
! 284:
! 285: } else if (IsMaplePointer(kv, alg)) {
! 286: DPRINTF(("maple pointer @ convert_maple2cmo\n"));
! 287:
! 288: } else if (IsMapleTable(kv, alg)) {
! 289: DPRINTF(("maple table@ convert_maple2cmo\n"));
! 290:
! 291: } else if (IsMapleRTable(kv, alg)) {
! 292: DPRINTF(("maple rtable@ convert_maple2cmo\n"));
! 293: ALGEB s, F;
! 294:
! 295: F = ToMapleName(kv, "F", TRUE);
! 296: MapleAssign(kv, F, alg);
! 297:
! 298: /* matrix */
! 299: s = EvalMapleStatement(kv, "type(F, Matrix):");
! 300: if (MapleToInteger32(kv, s)) {
! 301: return (conv_matrix2cmo(kv, "F"));
! 302: }
! 303:
! 304: } else if (IsMapleNULL(kv, alg)) {
! 305: DPRINTF(("maple null@ convert_maple2cmo\n"));
! 306:
! 307: } else if (IsMapleAssignedName(kv, alg)) {
! 308: DPRINTF(("maple assigned name @ convert_maple2cmo\n"));
! 309:
! 310: } else if (IsMapleUnassignedName(kv, alg)) {
! 311: DPRINTF(("maple unassigned name @ convert_maple2cmo\n"));
! 312:
! 313: } else if (IsMapleList(kv, alg)) {
! 314: DPRINTF(("maple IsMapleList @ conv_num2cmo\n"));
! 315: return (conv_list2cmo(kv, alg));
! 316: } else {
! 317: DPRINTF(("mapleunknown @ convert_maple2cmo\n"));
! 318: ALGEB s, F;
! 319:
! 320: F = ToMapleName(kv, "F", TRUE);
! 321: MapleAssign(kv, F, alg);
! 322:
! 323:
! 324: /* polynomial */
! 325: s = EvalMapleStatement(kv, "type(F, polynom(integer)):");
! 326: if (MapleToInteger32(kv, s)) {
! 327: return (conv_poly2cmo(kv, "F"));
! 328: }
! 329:
! 330:
! 331: }
! 332:
! 333: return ((cmo *)new_cmo_error2((cmo *)new_cmo_string("cant convert from mapleObj to CMO")));
! 334:
! 335: }
! 336:
! 337:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to m2c.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_maple