Annotation of OpenXM/src/ox_toolkit/cmo.c, Revision 1.29
1.1 ohara 1: /* -*- mode: C; coding: euc-japan -*- */
1.29 ! ohara 2: /* $OpenXM: OpenXM/src/ox_toolkit/cmo.c,v 1.28 2018/04/03 09:58:30 ohara Exp $ */
1.1 ohara 3:
4: /*
5: This module includes functions for sending/receiveng CMO's.
6: */
7:
8: #include <stdio.h>
9: #include <stdlib.h>
10: #include <stdarg.h>
11: #include <string.h>
1.23 noro 12: #include <mpfr.h>
1.1 ohara 13: #include "ox_toolkit.h"
14: #include "parse.h"
15:
1.12 ohara 16: static cell* new_cell(cmo *ob, int e);
1.1 ohara 17: static char* new_string_set_cmo_null();
18: static char* new_string_set_cmo_int32(int integer);
19: static char* new_string_set_cmo_list(cmo_list *c);
20: static char* new_string_set_cmo_zz(cmo_zz *c);
1.7 ohara 21: static char* new_string_set_cmo_double(cmo_double *m);
1.1 ohara 22:
23: /* functions for a cmo_list */
1.12 ohara 24: static cell* new_cell(cmo *ob, int e)
1.1 ohara 25: {
1.11 ohara 26: cell* h = MALLOC(sizeof(cell));
1.1 ohara 27: h->next = NULL;
28: h->prev = NULL;
29: h->cmo = ob;
1.12 ohara 30: h->exp = e;
1.1 ohara 31: return h;
32: }
33:
34: cell* list_next(cell *el)
35: {
36: return el->next;
37: }
38:
39: cell* list_first(cmo_list *this)
40: {
41: return this->head->next;
42: }
43:
44: cmo* list_first_cmo(cmo_list *this)
45: {
46: return list_first(this)->cmo;
47: }
48:
49: int list_endof(cmo_list *this, cell *el)
50: {
51: return (this->head == el);
52: }
53:
54: /* (prev, head) => (prev, new, head) */
55: static void list_cons(cell *head, cell *new)
56: {
57: cell* prev = head->prev;
58: new->prev = prev;
59: head->prev = new;
60: prev->next = new;
61: new->next = head;
62: }
63:
64: cmo_list *list_append(cmo_list* this, cmo* ob)
65: {
1.12 ohara 66: list_cons(this->head, new_cell(ob, 0));
67: this->length++;
68: return this;
69: }
70:
71: cmo_list *list_append_monomial(cmo_list* this, cmo* coef, int exp)
72: {
73: list_cons(this->head, new_cell(coef, exp));
1.1 ohara 74: this->length++;
75: return this;
76: }
77:
78: /* call as list_appendl(List, ob1, ob2, ob3, NULL) */
79: cmo_list *list_appendl(cmo_list* this, ...)
80: {
81: cmo *ob;
82: va_list ap;
83: va_start(ap, this);
1.3 ohara 84: if (this == NULL) {
85: this = new_cmo_list();
86: }
1.1 ohara 87: while((ob = va_arg(ap, cmo *)) != NULL) {
88: list_append(this, ob);
89: }
90: va_end(ap);
91: return this;
92: }
93:
94: int list_length(cmo_list* this)
95: {
96: return this->length;
97: }
98:
99: cmo *list_nth(cmo_list* this, int n)
100: {
101: cell* el;
102: if(list_length(this) > n) {
103: el = list_first(this);
104: while(n-- > 0) {
105: el = list_next(el);
106: }
107: return el->cmo;
108: }
109: return NULL;
110: }
111:
1.29 ! ohara 112: cell *list_nth_cell(cmo_list* this, int n)
! 113: {
! 114: cell* el;
! 115: if(list_length(this) > n) {
! 116: el = list_first(this);
! 117: while(n-- > 0) {
! 118: el = list_next(el);
! 119: }
! 120: return el;
! 121: }
! 122: return NULL;
! 123: }
! 124:
1.28 ohara 125: char *cmo_indeterminate_get_name(cmo_indeterminate *this)
126: {
127: cmo_string *ob = (cmo_string *)this->ob;
128: return ob->s;
129: }
130:
1.1 ohara 131: /* for GNU mpz */
132: void resize_mpz(mpz_ptr mpz, int size)
133: {
134: _mpz_realloc(mpz, abs(size));
135: mpz->_mp_size = size;
136: }
137:
138: /* functions named new_cmo_*. */
139: cmo_null* new_cmo_null()
140: {
1.13 ohara 141: cmo_null* m = MALLOC_ATOMIC(sizeof(cmo_null));
1.1 ohara 142: m->tag = CMO_NULL;
143: return m;
144: }
145:
146: cmo_int32* new_cmo_int32(int i)
147: {
148: cmo_int32* c;
1.13 ohara 149: c = MALLOC_ATOMIC(sizeof(cmo_int32));
150: c->tag = CMO_INT32;
1.1 ohara 151: c->i = i;
152: return c;
153: }
154:
155: cmo_string* new_cmo_string(char* s)
156: {
1.11 ohara 157: cmo_string* c = MALLOC(sizeof(cmo_string));
1.1 ohara 158: c->tag = CMO_STRING;
159: if (s != NULL) {
1.13 ohara 160: c->s = MALLOC_ATOMIC(strlen(s)+1);
1.1 ohara 161: strcpy(c->s, s);
162: }else {
163: c->s = NULL;
164: }
165: return c;
166: }
167:
168: cmo_mathcap* new_cmo_mathcap(cmo* ob)
169: {
1.11 ohara 170: cmo_mathcap* c = MALLOC(sizeof(cmo_mathcap));
1.1 ohara 171: c->tag = CMO_MATHCAP;
172: c->ob = ob;
173: return c;
174: }
175:
176: cmo_list* new_cmo_list()
177: {
1.11 ohara 178: cmo_list* c = MALLOC(sizeof(cmo_list));
1.1 ohara 179: c->tag = CMO_LIST;
180: c->length = 0;
181: c->head->next = c->head;
182: c->head->prev = c->head;
1.19 ohara 183: return c;
184: }
185:
1.21 takayama 186: cmo_list* new_cmo_list_array(void *array[], int n)
1.19 ohara 187: {
188: int i;
189: cmo_list* c = new_cmo_list();
190: for(i=0; i<n; i++) {
191: list_append(c, array[i]);
192: }
193: return c;
194: }
195:
1.21 takayama 196: cmo_list* new_cmo_list_array_map(void *array[], int n, void *(* mapf)(void *))
1.19 ohara 197: {
198: int i;
199: cmo_list* c = new_cmo_list();
200: for(i=0; i<n; i++) {
201: list_append(c, (cmo *)mapf(array[i]));
202: }
1.1 ohara 203: return c;
204: }
205:
206: cmo_monomial32* new_cmo_monomial32()
207: {
1.11 ohara 208: cmo_monomial32* c = MALLOC(sizeof(cmo_monomial32));
1.1 ohara 209: c->tag = CMO_MONOMIAL32;
210: return c;
211: }
212:
213: cmo_monomial32* new_cmo_monomial32_size(int size)
214: {
215: cmo_monomial32* c = new_cmo_monomial32();
216: if (size>0) {
217: c->length = size;
1.11 ohara 218: c->exps = MALLOC(sizeof(int)*size);
1.1 ohara 219: }
220: return c;
221: }
222:
223: cmo_zz* new_cmo_zz()
224: {
1.11 ohara 225: cmo_zz* c = MALLOC(sizeof(cmo_zz));
1.1 ohara 226: c->tag = CMO_ZZ;
227: mpz_init(c->mpz);
228: return c;
229: }
230:
231: cmo_zz* new_cmo_zz_noinit()
232: {
1.11 ohara 233: cmo_zz* c = MALLOC(sizeof(cmo_zz));
1.1 ohara 234: c->tag = CMO_ZZ;
235: return c;
236: }
237:
238: cmo_zz* new_cmo_zz_set_si(int i)
239: {
240: cmo_zz* c = new_cmo_zz();
241: mpz_set_si(c->mpz, i);
242: return c;
243: }
244:
245: cmo_zz* new_cmo_zz_set_mpz(mpz_ptr z)
246: {
247: cmo_zz* c = new_cmo_zz();
248: mpz_set(c->mpz, z);
249: return c;
250: }
251:
252: cmo_zz *new_cmo_zz_set_string(char *s)
253: {
254: cmo_zz* c = new_cmo_zz_noinit();
255: mpz_init_set_str(c->mpz, s, 10);
256: return c;
257: }
258:
259: cmo_zz* new_cmo_zz_size(int size)
260: {
261: cmo_zz* c = new_cmo_zz();
262: resize_mpz(c->mpz, size);
263: return c;
264: }
265:
1.22 ohara 266: cmo_qq* new_cmo_qq()
1.18 ohara 267: {
268: cmo_qq* c = MALLOC(sizeof(cmo_qq));
269: c->tag = CMO_QQ;
1.22 ohara 270: mpq_init(c->mpq);
1.18 ohara 271: return c;
272: }
273:
1.23 noro 274: cmo_bf* new_cmo_bf()
275: {
276: cmo_bf* c = MALLOC(sizeof(cmo_bf));
1.26 ohara 277: c->tag = CMO_BIGFLOAT32;
1.23 noro 278: mpfr_init(c->mpfr);
279: return c;
280: }
281:
1.25 noro 282: cmo_complex* new_cmo_complex()
283: {
284: cmo_complex* c = MALLOC(sizeof(cmo_complex));
285: c->tag = CMO_COMPLEX;
286: return c;
287: }
288:
1.18 ohara 289: cmo_qq* new_cmo_qq_set_mpq(mpq_ptr q)
290: {
1.22 ohara 291: cmo_qq* c = new_cmo_qq();
292: mpq_set(c->mpq, q);
1.18 ohara 293: return c;
294: }
295:
296: cmo_qq* new_cmo_qq_set_mpz(mpz_ptr num, mpz_ptr den)
297: {
1.22 ohara 298: cmo_qq* c = new_cmo_qq();
299: mpq_set_num(c->mpq, num);
300: mpq_set_den(c->mpq, den);
1.18 ohara 301: return c;
302: }
303:
1.23 noro 304: cmo_bf* new_cmo_bf_set_mpfr(mpfr_ptr num)
305: {
306: cmo_bf* c = new_cmo_bf();
307: mpfr_init2(c->mpfr,num->_mpfr_prec);
308: mpfr_set(c->mpfr,num,MPFR_RNDN);
309: return c;
310: }
311:
1.25 noro 312: cmo_complex* new_cmo_complex_set_re_im(cmo *re,cmo *im)
313: {
314: cmo_complex* c = new_cmo_complex();
315: c->re = re;
316: c->im = im;
317: return c;
318: }
319:
1.1 ohara 320: cmo_zero* new_cmo_zero()
321: {
1.13 ohara 322: cmo_zero* m = MALLOC_ATOMIC(sizeof(cmo_zero));
1.1 ohara 323: m->tag = CMO_ZERO;
1.6 ohara 324: return m;
325: }
326:
327: cmo_double *new_cmo_double(double d)
328: {
1.13 ohara 329: cmo_double* m = MALLOC_ATOMIC(sizeof(cmo_double));
1.18 ohara 330: m->tag = CMO_IEEE_DOUBLE_FLOAT;
1.6 ohara 331: m->d = d;
1.1 ohara 332: return m;
333: }
334:
335: cmo_dms_generic* new_cmo_dms_generic()
336: {
1.13 ohara 337: cmo_dms_generic* m = MALLOC_ATOMIC(sizeof(cmo_dms_generic));
1.1 ohara 338: m->tag = CMO_DMS_GENERIC;
339: return m;
340: }
341:
342: cmo_ring_by_name* new_cmo_ring_by_name(cmo* ob)
343: {
1.11 ohara 344: cmo_ring_by_name* c = MALLOC(sizeof(cmo_ring_by_name));
1.1 ohara 345: c->tag = CMO_RING_BY_NAME;
346: c->ob = ob;
347: return c;
348: }
349:
350: cmo_indeterminate* new_cmo_indeterminate(cmo* ob)
351: {
1.11 ohara 352: cmo_indeterminate* c = MALLOC(sizeof(cmo_indeterminate));
1.1 ohara 353: c->tag = CMO_INDETERMINATE;
354: c->ob = ob;
355: return c;
356: }
357:
1.28 ohara 358: cmo_indeterminate* new_cmo_indeterminate_set_name(char *variable)
359: {
360: return new_cmo_indeterminate(new_cmo_string(variable));
361: }
362:
1.1 ohara 363: cmo_distributed_polynomial* new_cmo_distributed_polynomial()
364: {
1.11 ohara 365: cmo_distributed_polynomial* c = MALLOC(sizeof(cmo_distributed_polynomial));
1.1 ohara 366: c->tag = CMO_DISTRIBUTED_POLYNOMIAL;
367: c->length = 0;
368: c->head->next = c->head;
369: c->head->prev = c->head;
370: c->ringdef = NULL;
1.14 ohara 371: return c;
372: }
373:
374: cmo_polynomial_in_one_variable* new_cmo_polynomial_in_one_variable(int var)
375: {
376: cmo_polynomial_in_one_variable* c = MALLOC(sizeof(cmo_polynomial_in_one_variable));
377: c->tag = CMO_POLYNOMIAL_IN_ONE_VARIABLE;
378: c->length = 0;
379: c->head->next = c->head;
380: c->head->prev = c->head;
381: c->var = var;
382: return c;
383: }
384:
1.15 ohara 385: cmo_recursive_polynomial* new_cmo_recursive_polynomial(cmo_list* ringdef, cmo* coef)
1.14 ohara 386: {
387: cmo_recursive_polynomial* c = MALLOC(sizeof(cmo_recursive_polynomial));
388: c->tag = CMO_RECURSIVE_POLYNOMIAL;
389: c->ringdef = ringdef;
390: c->coef = coef;
1.16 ohara 391: return c;
392: }
393:
394: cmo_tree* new_cmo_tree(cmo_string* name, cmo_list* attributes, cmo_list* leaves)
395: {
396: cmo_tree* c = MALLOC(sizeof(cmo_tree));
397: c->tag = CMO_TREE;
398: c->name= name;
399: c->attributes = attributes;
400: c->leaves = leaves;
401: return c;
402: }
403:
404: cmo_lambda* new_cmo_lambda(cmo_list* args, cmo_tree* body)
405: {
406: cmo_lambda* c = MALLOC(sizeof(cmo_lambda));
407: c->tag = CMO_LAMBDA;
408: c->args = args;
409: c->body = body;
1.1 ohara 410: return c;
411: }
412:
413: cmo_error2* new_cmo_error2(cmo* ob)
414: {
1.11 ohara 415: cmo_error2* c = MALLOC(sizeof(cmo_error2));
1.1 ohara 416: c->tag = CMO_ERROR2;
417: c->ob = ob;
418: return c;
419: }
420:
1.2 ohara 421:
422: /* Following functions translate cmo's to (asciiz) strings. */
1.1 ohara 423: static char *new_string_set_cmo_zz(cmo_zz *c)
424: {
425: return mpz_get_str(NULL, 10, c->mpz);
426: }
427:
428: static char *new_string_set_cmo_null()
429: {
430: static char* null_string = "";
431: return null_string;
432: }
433:
434: static char *new_string_set_cmo_int32(int integer)
435: {
436: char buff[1024];
437: char *s;
438:
439: sprintf(buff, "%d", integer);
1.11 ohara 440: s = MALLOC(strlen(buff)+1);
1.1 ohara 441: strcpy(s, buff);
442:
443: return s;
444: }
445:
446: static char *new_string_set_cmo_list(cmo_list *m)
447: {
448: char *s;
449: int i;
450: int size = 0;
451: int len = list_length(m);
1.11 ohara 452: char **sp = ALLOCA(len*sizeof(cmo *));
1.1 ohara 453:
454: cell* cp = list_first(m);
455: for(i = 0; i < len; i++) {
456: sp[i] = new_string_set_cmo(cp->cmo);
457: size += strlen(sp[i]) + 3;
458: cp = list_next(cp);
459: }
1.11 ohara 460: s = MALLOC(size+2);
1.1 ohara 461: strcpy(s, "[ ");
462: for(i = 0; i < len - 1; i++) {
463: strcat(s, sp[i]);
464: strcat(s, " , ");
465: }
1.17 iwane 466: if (len > 0)
467: strcat(s, sp[len-1]);
1.1 ohara 468: strcat(s, " ]");
469: return s;
470: }
471:
1.7 ohara 472: static char *new_string_set_cmo_double(cmo_double *m)
473: {
474: char buff[1024];
475: char *s;
476:
1.13 ohara 477: sprintf(buff, "%.20f", m->d);
478: s = MALLOC_ATOMIC(strlen(buff)+1);
1.7 ohara 479: strcpy(s, buff);
480:
481: return s;
482: }
483:
1.1 ohara 484: char *new_string_set_cmo(cmo *m)
485: {
486: switch(m->tag) {
487: case CMO_ZZ:
488: return new_string_set_cmo_zz((cmo_zz *)m);
489: case CMO_INT32:
490: return new_string_set_cmo_int32(((cmo_int32 *)m)->i);
491: case CMO_STRING:
492: return ((cmo_string *)m)->s;
493: case CMO_NULL:
494: return new_string_set_cmo_null();
495: case CMO_LIST:
496: return new_string_set_cmo_list((cmo_list *)m);
1.18 ohara 497: case CMO_64BIT_MACHINE_DOUBLE:
498: case CMO_IEEE_DOUBLE_FLOAT:
1.15 ohara 499: return new_string_set_cmo_double((cmo_double *)m);
1.1 ohara 500: default:
1.8 ohara 501: ox_printf("unconvertible <%s>\n", get_symbol_by_tag(m->tag));
1.1 ohara 502: /* yet not implemented. */
503: return NULL;
504: }
505: }
1.24 noro 506:
507: int cmo_to_int(cmo *n)
508: {
1.28 ohara 509: switch(n->tag) {
1.24 noro 510: case CMO_ZERO:
511: return 0;
512: case CMO_INT32:
513: return ((cmo_int32 *)n)->i;
514: case CMO_ZZ:
515: return mpz_get_si(((cmo_zz *)n)->mpz);
516: default:
517: return 0;
1.28 ohara 518: }
1.24 noro 519: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to cmo.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_toolkit