File: [local] / OpenXM / src / ox_maple / m2c.c (download)
Revision 1.1, Fri Sep 19 13:01:05 2008 UTC (16 years ago) by iwane
Branch: MAIN
CVS Tags: R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, HEAD
OpenXM Maple server
|
/* $OpenXM: OpenXM/src/ox_maple/m2c.c,v 1.1 2008/09/19 13:01:05 iwane Exp $ */
/************************************************************************
* MapleObject --> CMO converter
*
*********************************************************************** */
#include "oxmaple.h"
#include "maplec.h"
/*==========================================================================*
* Block interrupt input
*==========================================================================*/
/*
#define BLOCK_NEW_CMO() BLOCK_INPUT()
#define UNBLOCK_NEW_CMO() UNBLOCK_INPUT()
*/
#define BLOCK_NEW_CMO()
#define UNBLOCK_NEW_CMO()
#define DPRINTF(x) printf x; fflush(stdout)
char *
convert_maple2str(MKernelVector kv, ALGEB alg)
{
ALGEB s;
char *str;
s = MapleALGEB_SPrintf(kv, "%a", alg);
str = MapleToString(kv, s);
return (str);
}
cmo *
conv_num2cmo(MKernelVector kv, ALGEB alg)
{
int n;
char buf[124];
ALGEB s;
/* $B$I!<$b(B asir $B$N(B CMO_INT32 $B$OIi$N?t$KBP1~$7$F$$$J$$MM;R(B */
if (IsMapleInteger16(kv, alg)) {
n = MapleToInteger16(kv, alg);
return ((cmo *)new_cmo_zz_set_si(n));
/* return ((cmo *)new_cmo_int32(n)); */
} else if (IsMapleInteger32(kv, alg)) {
n = MapleToInteger32(kv, alg);
return ((cmo *)new_cmo_zz_set_si(n));
/* return ((cmo *)new_cmo_int32(n)); */
} else if (IsMapleInteger(kv, alg)) {
mpz_ptr z = MapleToGMPInteger(kv, alg);
cmo_zz *c = new_cmo_zz_set_mpz(z);
return ((cmo *)c);
}
#if 1
else if (IsMapleAssignedName(kv, alg)) { DPRINTF(("maple IsMapleAssignedName @ conv_num2cmo\n")); }
else if (IsMapleComplexNumeric(kv, alg)) { DPRINTF(("maple IsMapleComplexNumeric @ conv_num2cmo\n")); }
else if (IsMapleInteger(kv, alg)) { DPRINTF(("maple IsMapleInteger @ conv_num2cmo\n")); }
else if (IsMapleInteger16(kv, alg)) { DPRINTF(("maple IsMapleInteger16 @ conv_num2cmo\n")); }
else if (IsMapleInteger32(kv, alg)) { DPRINTF(("maple IsMapleInteger32 @ conv_num2cmo\n")); }
else if (IsMapleInteger64(kv, alg)) { DPRINTF(("maple IsMapleInteger64 @ conv_num2cmo\n")); }
else if (IsMapleInteger8(kv, alg)) { DPRINTF(("maple IsMapleInteger8 @ conv_num2cmo\n")); }
else if (IsMapleList(kv, alg)) { DPRINTF(("maple IsMapleList @ conv_num2cmo\n")); }
else if (IsMapleName(kv, alg)) { DPRINTF(("maple IsMapleName @ conv_num2cmo\n")); }
else if (IsMapleNULL(kv, alg)) { DPRINTF(("maple IsMapleNULL @ conv_num2cmo\n")); }
else if (IsMaplePointer(kv, alg)) { DPRINTF(("maple IsMaplePointer @ conv_num2cmo\n")); }
else if (IsMaplePointerNULL(kv, alg)) { DPRINTF(("maple IsMaplePointerNULL @ conv_num2cmo\n")); }
else if (IsMapleProcedure(kv, alg)) { DPRINTF(("maple IsMapleProcedure @ conv_num2cmo\n")); }
else if (IsMapleRTable(kv, alg)) { DPRINTF(("maple IsMapleRTable @ conv_num2cmo\n")); }
else if (IsMapleSet(kv, alg)) { DPRINTF(("maple IsMapleSet @ conv_num2cmo\n")); }
else if (IsMapleStop(kv, alg)) { DPRINTF(("maple IsMapleStop @ conv_num2cmo\n")); }
else if (IsMapleString(kv, alg)) { DPRINTF(("maple IsMapleString @ conv_num2cmo\n")); }
else if (IsMapleTable(kv, alg)) { DPRINTF(("maple IsMapleTable @ conv_num2cmo\n")); }
else if (IsMapleUnassignedName(kv, alg)) { DPRINTF(("maple IsMapleUnassignedName @ conv_num2cmo\n")); }
else if (IsMapleUnnamedZero(kv, alg)) { DPRINTF(("maple IsMapleUnnamedZero @ conv_num2cmo\n")); }
#endif
DPRINTF(("maple unknown @ convert_conv_num2cmo \n"));
s = ToMapleName(kv, "tmp", TRUE);
MapleAssign(kv, s, alg);
sprintf(buf, "type(tmp, rational):");
s = EvalMapleStatement(kv, buf);
if (MapleToInteger32(kv, s)) {
mpz_ptr p1, p2;
cmo_qq *q;
sprintf(buf, "numer(tmp):");
p1 = MapleToGMPInteger(kv, EvalMapleStatement(kv, buf));
sprintf(buf, "denom(tmp):");
p2 = MapleToGMPInteger(kv, EvalMapleStatement(kv, buf));
q = new_cmo_qq_set_mpz(p1, p2);
return ((cmo *)q);
}
/* float @@TODO */
printf("unknown type found. return NULL.\n");
return NULL;
}
static cmo_polynomial_in_one_variable *
conv_1poly2cmo(MKernelVector kv, const char *f, cell *cl, int lv, char *buf)
{
char buf2[10];
int i, deg;
ALGEB s;
cmo *cm;
cmo_polynomial_in_one_variable *poly;
const char *x;
cm = cl->cmo; /* indeterminate */
cm = ((cmo_indeterminate *)cm)->ob; /* string */
x = ((cmo_string *)cm)->s;
sprintf(buf, "degree(%s,%s):", f, x);
s = EvalMapleStatement(kv, buf);
deg = MapleToInteger32(kv, s);
if (deg < 0) {
return (conv_1poly2cmo(kv, f, cl->next, lv + 1, buf));
}
poly = new_cmo_polynomial_in_one_variable(lv);
for (i = deg; i >= 0; i--) {
sprintf(buf, "%s_%d:=coeff(%s,%s,%d):", f, lv, f, x, i);
s = EvalMapleStatement(kv, buf);
if (!IsMapleUnnamedZero(kv, s)) {
if (IsMapleNumeric(kv, s)) {
cm = conv_num2cmo(kv, s);
} else {
sprintf(buf2, "%s_%d", f, lv);
cm = (cmo *)conv_1poly2cmo(kv, buf2, cl->next, lv + 1, buf);
}
if (cm == NULL) {
return (NULL);
}
list_append_monomial((cmo_list *)poly, cm, i);
}
}
return (poly);
}
static cmo *
conv_matrix2cmo(MKernelVector kv, const char *f)
{
char buf[100];
int row;
int col;
int i, j;
cmo_list *list;
ALGEB s;
sprintf(buf, "LinearAlgebra[RowDimension](%s):", f);
s = EvalMapleStatement(kv, buf);
row = MapleToInteger32(kv, s);
sprintf(buf, "LinearAlgebra[ColumnDimension](%s):", f);
s = EvalMapleStatement(kv, buf);
col = MapleToInteger32(kv, s);
list = new_cmo_list();
list_append(list, (cmo *)new_cmo_int32(row));
list_append(list, (cmo *)new_cmo_int32(col));
/* RTableSelect $B$r;H$&$Y$-$+(B @@TODO */
for (i = 1; i <= row; i++) {
for (j = 1; j <= col; j++) {
sprintf(buf, "%s[%d,%d]:", f, i, j);
s = EvalMapleStatement(kv, buf);
list_append(list, convert_maple2cmo(kv, s));
}
}
return ((cmo *)list);
}
static cmo *
conv_poly2cmo(MKernelVector kv, const char *f)
{
ALGEB s, s2;
char buf[100];
cmo_recursive_polynomial *rec;
cmo_polynomial_in_one_variable *poly;
cmo_list *ringdef;
int i;
int varn;
cell *cl;
char *x;
sprintf(buf, "%s_n := indets(%s):", f, f);
s = EvalMapleStatement(kv, buf);
sprintf(buf, "nops(%s_n):", f);
s2 = EvalMapleStatement(kv, buf);
varn = MapleToInteger32(kv, s2);
BLOCK_NEW_CMO();
ringdef = new_cmo_list();
for (i = 1; i <= varn; i++) {
cmo_indeterminate *xc;
sprintf(buf, "%s_n[%d]:", f, i);
s = EvalMapleStatement(kv, buf);
x = MapleToString(kv, s);
xc = new_cmo_indeterminate((cmo *)new_cmo_string(x));
list_append(ringdef, (cmo *)xc);
}
cl = ringdef->head->next;
poly = conv_1poly2cmo(kv, f, cl, 0, buf);
rec = new_cmo_recursive_polynomial(ringdef, (cmo *)poly);
UNBLOCK_NEW_CMO();
if (poly == NULL) {
return (NULL);
}
return ((cmo *)rec);
}
static cmo *
conv_list2cmo(MKernelVector kv, ALGEB alg)
{
int i, n;
ALGEB s;
char *str;
cmo_list *list;
cmo *c;
s = MapleALGEB_SPrintf(kv, "nops(%a):", alg);
str = MapleToString(kv, s);
n = MapleToInteger32(kv, EvalMapleStatement(kv, str));
list = new_cmo_list();
for (i = 1; i <= n; i++) {
s = MapleListSelect(kv, alg, i);
c = convert_maple2cmo(kv, s);
if (c == NULL) {
list = NULL;
break;
}
list_append(list, c);
}
return ((cmo *)list);
}
cmo *
convert_maple2cmo(MKernelVector kv, ALGEB alg)
{
if (IsMapleNumeric(kv, alg)) {
return (conv_num2cmo(kv, alg));
} else if (IsMapleString(kv, alg)) {
DPRINTF(("maplestring @ convert_maple2cmo\n"));
char *str = MapleToString(kv, alg);
return ((cmo *)new_cmo_string(str));
} else if (IsMapleExpressionSequence(kv, alg)) {
DPRINTF(("mapleexpress@ convert_maple2cmo\n"));
} else if (IsMapleAssignedName(kv, alg)) {
DPRINTF(("maple assigned name@ convert_maple2cmo\n"));
} else if (IsMapleProcedure(kv, alg)) {
DPRINTF(("maple procedure @ convert_maple2cmo\n"));
} else if (IsMaplePointer(kv, alg)) {
DPRINTF(("maple pointer @ convert_maple2cmo\n"));
} else if (IsMapleTable(kv, alg)) {
DPRINTF(("maple table@ convert_maple2cmo\n"));
} else if (IsMapleRTable(kv, alg)) {
DPRINTF(("maple rtable@ convert_maple2cmo\n"));
ALGEB s, F;
F = ToMapleName(kv, "F", TRUE);
MapleAssign(kv, F, alg);
/* matrix */
s = EvalMapleStatement(kv, "type(F, Matrix):");
if (MapleToInteger32(kv, s)) {
return (conv_matrix2cmo(kv, "F"));
}
} else if (IsMapleNULL(kv, alg)) {
DPRINTF(("maple null@ convert_maple2cmo\n"));
} else if (IsMapleAssignedName(kv, alg)) {
DPRINTF(("maple assigned name @ convert_maple2cmo\n"));
} else if (IsMapleUnassignedName(kv, alg)) {
DPRINTF(("maple unassigned name @ convert_maple2cmo\n"));
} else if (IsMapleList(kv, alg)) {
DPRINTF(("maple IsMapleList @ conv_num2cmo\n"));
return (conv_list2cmo(kv, alg));
} else {
DPRINTF(("mapleunknown @ convert_maple2cmo\n"));
ALGEB s, F;
F = ToMapleName(kv, "F", TRUE);
MapleAssign(kv, F, alg);
/* polynomial */
s = EvalMapleStatement(kv, "type(F, polynom(integer)):");
if (MapleToInteger32(kv, s)) {
return (conv_poly2cmo(kv, "F"));
}
}
return ((cmo *)new_cmo_error2((cmo *)new_cmo_string("cant convert from mapleObj to CMO")));
}