version 1.11, 2003/06/02 10:25:56 |
version 1.28, 2018/04/03 09:58:30 |
|
|
/* -*- mode: C; coding: euc-japan -*- */ |
/* -*- mode: C; coding: euc-japan -*- */ |
/* $OpenXM: OpenXM/src/ox_toolkit/cmo.c,v 1.10 2003/03/30 08:05:22 ohara Exp $ */ |
/* $OpenXM: OpenXM/src/ox_toolkit/cmo.c,v 1.27 2016/06/30 01:14:00 ohara Exp $ */ |
|
|
/* |
/* |
This module includes functions for sending/receiveng CMO's. |
This module includes functions for sending/receiveng CMO's. |
Some commnets is written in Japanese by the EUC-JP coded |
|
character set. |
|
*/ |
*/ |
|
|
#include <stdio.h> |
#include <stdio.h> |
#include <stdlib.h> |
#include <stdlib.h> |
#include <stdarg.h> |
#include <stdarg.h> |
#include <string.h> |
#include <string.h> |
|
#include <mpfr.h> |
#include "ox_toolkit.h" |
#include "ox_toolkit.h" |
#include "parse.h" |
#include "parse.h" |
|
|
static cell* new_cell(); |
static cell* new_cell(cmo *ob, int e); |
static char* new_string_set_cmo_null(); |
static char* new_string_set_cmo_null(); |
static char* new_string_set_cmo_int32(int integer); |
static char* new_string_set_cmo_int32(int integer); |
static char* new_string_set_cmo_list(cmo_list *c); |
static char* new_string_set_cmo_list(cmo_list *c); |
Line 22 static char* new_string_set_cmo_zz(cmo_zz *c); |
|
Line 21 static char* new_string_set_cmo_zz(cmo_zz *c); |
|
static char* new_string_set_cmo_double(cmo_double *m); |
static char* new_string_set_cmo_double(cmo_double *m); |
|
|
/* functions for a cmo_list */ |
/* functions for a cmo_list */ |
static cell* new_cell(cmo *ob) |
static cell* new_cell(cmo *ob, int e) |
{ |
{ |
cell* h = MALLOC(sizeof(cell)); |
cell* h = MALLOC(sizeof(cell)); |
h->next = NULL; |
h->next = NULL; |
h->prev = NULL; |
h->prev = NULL; |
h->cmo = ob; |
h->cmo = ob; |
|
h->exp = e; |
return h; |
return h; |
} |
} |
|
|
Line 63 static void list_cons(cell *head, cell *new) |
|
Line 63 static void list_cons(cell *head, cell *new) |
|
|
|
cmo_list *list_append(cmo_list* this, cmo* ob) |
cmo_list *list_append(cmo_list* this, cmo* ob) |
{ |
{ |
list_cons(this->head, new_cell(ob)); |
list_cons(this->head, new_cell(ob, 0)); |
this->length++; |
this->length++; |
return this; |
return this; |
} |
} |
|
|
|
cmo_list *list_append_monomial(cmo_list* this, cmo* coef, int exp) |
|
{ |
|
list_cons(this->head, new_cell(coef, exp)); |
|
this->length++; |
|
return this; |
|
} |
|
|
/* call as list_appendl(List, ob1, ob2, ob3, NULL) */ |
/* call as list_appendl(List, ob1, ob2, ob3, NULL) */ |
cmo_list *list_appendl(cmo_list* this, ...) |
cmo_list *list_appendl(cmo_list* this, ...) |
{ |
{ |
Line 102 cmo *list_nth(cmo_list* this, int n) |
|
Line 109 cmo *list_nth(cmo_list* this, int n) |
|
return NULL; |
return NULL; |
} |
} |
|
|
|
char *cmo_indeterminate_get_name(cmo_indeterminate *this) |
|
{ |
|
cmo_string *ob = (cmo_string *)this->ob; |
|
return ob->s; |
|
} |
|
|
/* for GNU mpz */ |
/* for GNU mpz */ |
void resize_mpz(mpz_ptr mpz, int size) |
void resize_mpz(mpz_ptr mpz, int size) |
{ |
{ |
Line 112 void resize_mpz(mpz_ptr mpz, int size) |
|
Line 125 void resize_mpz(mpz_ptr mpz, int size) |
|
/* functions named new_cmo_*. */ |
/* functions named new_cmo_*. */ |
cmo_null* new_cmo_null() |
cmo_null* new_cmo_null() |
{ |
{ |
cmo_null* m = MALLOC(sizeof(cmo_null)); |
cmo_null* m = MALLOC_ATOMIC(sizeof(cmo_null)); |
m->tag = CMO_NULL; |
m->tag = CMO_NULL; |
return m; |
return m; |
} |
} |
Line 120 cmo_null* new_cmo_null() |
|
Line 133 cmo_null* new_cmo_null() |
|
cmo_int32* new_cmo_int32(int i) |
cmo_int32* new_cmo_int32(int i) |
{ |
{ |
cmo_int32* c; |
cmo_int32* c; |
c = MALLOC(sizeof(cmo_int32)); |
c = MALLOC_ATOMIC(sizeof(cmo_int32)); |
c->tag = CMO_INT32; |
c->tag = CMO_INT32; |
c->i = i; |
c->i = i; |
return c; |
return c; |
} |
} |
Line 131 cmo_string* new_cmo_string(char* s) |
|
Line 144 cmo_string* new_cmo_string(char* s) |
|
cmo_string* c = MALLOC(sizeof(cmo_string)); |
cmo_string* c = MALLOC(sizeof(cmo_string)); |
c->tag = CMO_STRING; |
c->tag = CMO_STRING; |
if (s != NULL) { |
if (s != NULL) { |
c->s = MALLOC(strlen(s)+1); |
c->s = MALLOC_ATOMIC(strlen(s)+1); |
strcpy(c->s, s); |
strcpy(c->s, s); |
}else { |
}else { |
c->s = NULL; |
c->s = NULL; |
Line 157 cmo_list* new_cmo_list() |
|
Line 170 cmo_list* new_cmo_list() |
|
return c; |
return c; |
} |
} |
|
|
|
cmo_list* new_cmo_list_array(void *array[], int n) |
|
{ |
|
int i; |
|
cmo_list* c = new_cmo_list(); |
|
for(i=0; i<n; i++) { |
|
list_append(c, array[i]); |
|
} |
|
return c; |
|
} |
|
|
|
cmo_list* new_cmo_list_array_map(void *array[], int n, void *(* mapf)(void *)) |
|
{ |
|
int i; |
|
cmo_list* c = new_cmo_list(); |
|
for(i=0; i<n; i++) { |
|
list_append(c, (cmo *)mapf(array[i])); |
|
} |
|
return c; |
|
} |
|
|
cmo_monomial32* new_cmo_monomial32() |
cmo_monomial32* new_cmo_monomial32() |
{ |
{ |
cmo_monomial32* c = MALLOC(sizeof(cmo_monomial32)); |
cmo_monomial32* c = MALLOC(sizeof(cmo_monomial32)); |
Line 217 cmo_zz* new_cmo_zz_size(int size) |
|
Line 250 cmo_zz* new_cmo_zz_size(int size) |
|
return c; |
return c; |
} |
} |
|
|
|
cmo_qq* new_cmo_qq() |
|
{ |
|
cmo_qq* c = MALLOC(sizeof(cmo_qq)); |
|
c->tag = CMO_QQ; |
|
mpq_init(c->mpq); |
|
return c; |
|
} |
|
|
|
cmo_bf* new_cmo_bf() |
|
{ |
|
cmo_bf* c = MALLOC(sizeof(cmo_bf)); |
|
c->tag = CMO_BIGFLOAT32; |
|
mpfr_init(c->mpfr); |
|
return c; |
|
} |
|
|
|
cmo_complex* new_cmo_complex() |
|
{ |
|
cmo_complex* c = MALLOC(sizeof(cmo_complex)); |
|
c->tag = CMO_COMPLEX; |
|
return c; |
|
} |
|
|
|
cmo_qq* new_cmo_qq_set_mpq(mpq_ptr q) |
|
{ |
|
cmo_qq* c = new_cmo_qq(); |
|
mpq_set(c->mpq, q); |
|
return c; |
|
} |
|
|
|
cmo_qq* new_cmo_qq_set_mpz(mpz_ptr num, mpz_ptr den) |
|
{ |
|
cmo_qq* c = new_cmo_qq(); |
|
mpq_set_num(c->mpq, num); |
|
mpq_set_den(c->mpq, den); |
|
return c; |
|
} |
|
|
|
cmo_bf* new_cmo_bf_set_mpfr(mpfr_ptr num) |
|
{ |
|
cmo_bf* c = new_cmo_bf(); |
|
mpfr_init2(c->mpfr,num->_mpfr_prec); |
|
mpfr_set(c->mpfr,num,MPFR_RNDN); |
|
return c; |
|
} |
|
|
|
cmo_complex* new_cmo_complex_set_re_im(cmo *re,cmo *im) |
|
{ |
|
cmo_complex* c = new_cmo_complex(); |
|
c->re = re; |
|
c->im = im; |
|
return c; |
|
} |
|
|
cmo_zero* new_cmo_zero() |
cmo_zero* new_cmo_zero() |
{ |
{ |
cmo_zero* m = MALLOC(sizeof(cmo_zero)); |
cmo_zero* m = MALLOC_ATOMIC(sizeof(cmo_zero)); |
m->tag = CMO_ZERO; |
m->tag = CMO_ZERO; |
return m; |
return m; |
} |
} |
|
|
cmo_double *new_cmo_double(double d) |
cmo_double *new_cmo_double(double d) |
{ |
{ |
cmo_double* m = MALLOC(sizeof(cmo_double)); |
cmo_double* m = MALLOC_ATOMIC(sizeof(cmo_double)); |
m->tag = CMO_64BIT_MACHINE_DOUBLE; |
m->tag = CMO_IEEE_DOUBLE_FLOAT; |
m->d = d; |
m->d = d; |
return m; |
return m; |
} |
} |
|
|
cmo_dms_generic* new_cmo_dms_generic() |
cmo_dms_generic* new_cmo_dms_generic() |
{ |
{ |
cmo_dms_generic* m = MALLOC(sizeof(cmo_dms_generic)); |
cmo_dms_generic* m = MALLOC_ATOMIC(sizeof(cmo_dms_generic)); |
m->tag = CMO_DMS_GENERIC; |
m->tag = CMO_DMS_GENERIC; |
return m; |
return m; |
} |
} |
Line 255 cmo_indeterminate* new_cmo_indeterminate(cmo* ob) |
|
Line 342 cmo_indeterminate* new_cmo_indeterminate(cmo* ob) |
|
return c; |
return c; |
} |
} |
|
|
|
cmo_indeterminate* new_cmo_indeterminate_set_name(char *variable) |
|
{ |
|
return new_cmo_indeterminate(new_cmo_string(variable)); |
|
} |
|
|
cmo_distributed_polynomial* new_cmo_distributed_polynomial() |
cmo_distributed_polynomial* new_cmo_distributed_polynomial() |
{ |
{ |
cmo_distributed_polynomial* c = MALLOC(sizeof(cmo_distributed_polynomial)); |
cmo_distributed_polynomial* c = MALLOC(sizeof(cmo_distributed_polynomial)); |
Line 266 cmo_distributed_polynomial* new_cmo_distributed_polyno |
|
Line 358 cmo_distributed_polynomial* new_cmo_distributed_polyno |
|
return c; |
return c; |
} |
} |
|
|
|
cmo_polynomial_in_one_variable* new_cmo_polynomial_in_one_variable(int var) |
|
{ |
|
cmo_polynomial_in_one_variable* c = MALLOC(sizeof(cmo_polynomial_in_one_variable)); |
|
c->tag = CMO_POLYNOMIAL_IN_ONE_VARIABLE; |
|
c->length = 0; |
|
c->head->next = c->head; |
|
c->head->prev = c->head; |
|
c->var = var; |
|
return c; |
|
} |
|
|
|
cmo_recursive_polynomial* new_cmo_recursive_polynomial(cmo_list* ringdef, cmo* coef) |
|
{ |
|
cmo_recursive_polynomial* c = MALLOC(sizeof(cmo_recursive_polynomial)); |
|
c->tag = CMO_RECURSIVE_POLYNOMIAL; |
|
c->ringdef = ringdef; |
|
c->coef = coef; |
|
return c; |
|
} |
|
|
|
cmo_tree* new_cmo_tree(cmo_string* name, cmo_list* attributes, cmo_list* leaves) |
|
{ |
|
cmo_tree* c = MALLOC(sizeof(cmo_tree)); |
|
c->tag = CMO_TREE; |
|
c->name= name; |
|
c->attributes = attributes; |
|
c->leaves = leaves; |
|
return c; |
|
} |
|
|
|
cmo_lambda* new_cmo_lambda(cmo_list* args, cmo_tree* body) |
|
{ |
|
cmo_lambda* c = MALLOC(sizeof(cmo_lambda)); |
|
c->tag = CMO_LAMBDA; |
|
c->args = args; |
|
c->body = body; |
|
return c; |
|
} |
|
|
cmo_error2* new_cmo_error2(cmo* ob) |
cmo_error2* new_cmo_error2(cmo* ob) |
{ |
{ |
cmo_error2* c = MALLOC(sizeof(cmo_error2)); |
cmo_error2* c = MALLOC(sizeof(cmo_error2)); |
Line 319 static char *new_string_set_cmo_list(cmo_list *m) |
|
Line 450 static char *new_string_set_cmo_list(cmo_list *m) |
|
strcat(s, sp[i]); |
strcat(s, sp[i]); |
strcat(s, " , "); |
strcat(s, " , "); |
} |
} |
strcat(s, sp[len-1]); |
if (len > 0) |
|
strcat(s, sp[len-1]); |
strcat(s, " ]"); |
strcat(s, " ]"); |
return s; |
return s; |
} |
} |
Line 329 static char *new_string_set_cmo_double(cmo_double *m) |
|
Line 461 static char *new_string_set_cmo_double(cmo_double *m) |
|
char buff[1024]; |
char buff[1024]; |
char *s; |
char *s; |
|
|
sprintf(buff, "%lf", m->d); |
sprintf(buff, "%.20f", m->d); |
s = MALLOC(strlen(buff)+1); |
s = MALLOC_ATOMIC(strlen(buff)+1); |
strcpy(s, buff); |
strcpy(s, buff); |
|
|
return s; |
return s; |
Line 349 char *new_string_set_cmo(cmo *m) |
|
Line 481 char *new_string_set_cmo(cmo *m) |
|
return new_string_set_cmo_null(); |
return new_string_set_cmo_null(); |
case CMO_LIST: |
case CMO_LIST: |
return new_string_set_cmo_list((cmo_list *)m); |
return new_string_set_cmo_list((cmo_list *)m); |
case CMO_64BIT_MACHINE_DOUBLE: |
case CMO_64BIT_MACHINE_DOUBLE: |
return new_string_set_cmo_int32(m); |
case CMO_IEEE_DOUBLE_FLOAT: |
|
return new_string_set_cmo_double((cmo_double *)m); |
default: |
default: |
ox_printf("unconvertible <%s>\n", get_symbol_by_tag(m->tag)); |
ox_printf("unconvertible <%s>\n", get_symbol_by_tag(m->tag)); |
/* yet not implemented. */ |
/* yet not implemented. */ |
return NULL; |
return NULL; |
|
} |
|
} |
|
|
|
int cmo_to_int(cmo *n) |
|
{ |
|
switch(n->tag) { |
|
case CMO_ZERO: |
|
return 0; |
|
case CMO_INT32: |
|
return ((cmo_int32 *)n)->i; |
|
case CMO_ZZ: |
|
return mpz_get_si(((cmo_zz *)n)->mpz); |
|
default: |
|
return 0; |
} |
} |
} |
} |