Annotation of OpenXM/src/ox_toolkit/cmo.c, Revision 1.27
1.1 ohara 1: /* -*- mode: C; coding: euc-japan -*- */
1.27 ! ohara 2: /* $OpenXM: OpenXM/src/ox_toolkit/cmo.c,v 1.26 2016/06/29 05:07:23 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:
112: /* for GNU mpz */
113: void resize_mpz(mpz_ptr mpz, int size)
114: {
115: _mpz_realloc(mpz, abs(size));
116: mpz->_mp_size = size;
117: }
118:
119: /* functions named new_cmo_*. */
120: cmo_null* new_cmo_null()
121: {
1.13 ohara 122: cmo_null* m = MALLOC_ATOMIC(sizeof(cmo_null));
1.1 ohara 123: m->tag = CMO_NULL;
124: return m;
125: }
126:
127: cmo_int32* new_cmo_int32(int i)
128: {
129: cmo_int32* c;
1.13 ohara 130: c = MALLOC_ATOMIC(sizeof(cmo_int32));
131: c->tag = CMO_INT32;
1.1 ohara 132: c->i = i;
133: return c;
134: }
135:
136: cmo_string* new_cmo_string(char* s)
137: {
1.11 ohara 138: cmo_string* c = MALLOC(sizeof(cmo_string));
1.1 ohara 139: c->tag = CMO_STRING;
140: if (s != NULL) {
1.13 ohara 141: c->s = MALLOC_ATOMIC(strlen(s)+1);
1.1 ohara 142: strcpy(c->s, s);
143: }else {
144: c->s = NULL;
145: }
146: return c;
147: }
148:
149: cmo_mathcap* new_cmo_mathcap(cmo* ob)
150: {
1.11 ohara 151: cmo_mathcap* c = MALLOC(sizeof(cmo_mathcap));
1.1 ohara 152: c->tag = CMO_MATHCAP;
153: c->ob = ob;
154: return c;
155: }
156:
157: cmo_list* new_cmo_list()
158: {
1.11 ohara 159: cmo_list* c = MALLOC(sizeof(cmo_list));
1.1 ohara 160: c->tag = CMO_LIST;
161: c->length = 0;
162: c->head->next = c->head;
163: c->head->prev = c->head;
1.19 ohara 164: return c;
165: }
166:
1.21 takayama 167: cmo_list* new_cmo_list_array(void *array[], int n)
1.19 ohara 168: {
169: int i;
170: cmo_list* c = new_cmo_list();
171: for(i=0; i<n; i++) {
172: list_append(c, array[i]);
173: }
174: return c;
175: }
176:
1.21 takayama 177: cmo_list* new_cmo_list_array_map(void *array[], int n, void *(* mapf)(void *))
1.19 ohara 178: {
179: int i;
180: cmo_list* c = new_cmo_list();
181: for(i=0; i<n; i++) {
182: list_append(c, (cmo *)mapf(array[i]));
183: }
1.1 ohara 184: return c;
185: }
186:
187: cmo_monomial32* new_cmo_monomial32()
188: {
1.11 ohara 189: cmo_monomial32* c = MALLOC(sizeof(cmo_monomial32));
1.1 ohara 190: c->tag = CMO_MONOMIAL32;
191: return c;
192: }
193:
194: cmo_monomial32* new_cmo_monomial32_size(int size)
195: {
196: cmo_monomial32* c = new_cmo_monomial32();
197: if (size>0) {
198: c->length = size;
1.11 ohara 199: c->exps = MALLOC(sizeof(int)*size);
1.1 ohara 200: }
201: return c;
202: }
203:
204: cmo_zz* new_cmo_zz()
205: {
1.11 ohara 206: cmo_zz* c = MALLOC(sizeof(cmo_zz));
1.1 ohara 207: c->tag = CMO_ZZ;
208: mpz_init(c->mpz);
209: return c;
210: }
211:
212: cmo_zz* new_cmo_zz_noinit()
213: {
1.11 ohara 214: cmo_zz* c = MALLOC(sizeof(cmo_zz));
1.1 ohara 215: c->tag = CMO_ZZ;
216: return c;
217: }
218:
219: cmo_zz* new_cmo_zz_set_si(int i)
220: {
221: cmo_zz* c = new_cmo_zz();
222: mpz_set_si(c->mpz, i);
223: return c;
224: }
225:
226: cmo_zz* new_cmo_zz_set_mpz(mpz_ptr z)
227: {
228: cmo_zz* c = new_cmo_zz();
229: mpz_set(c->mpz, z);
230: return c;
231: }
232:
233: cmo_zz *new_cmo_zz_set_string(char *s)
234: {
235: cmo_zz* c = new_cmo_zz_noinit();
236: mpz_init_set_str(c->mpz, s, 10);
237: return c;
238: }
239:
240: cmo_zz* new_cmo_zz_size(int size)
241: {
242: cmo_zz* c = new_cmo_zz();
243: resize_mpz(c->mpz, size);
244: return c;
245: }
246:
1.22 ohara 247: cmo_qq* new_cmo_qq()
1.18 ohara 248: {
249: cmo_qq* c = MALLOC(sizeof(cmo_qq));
250: c->tag = CMO_QQ;
1.22 ohara 251: mpq_init(c->mpq);
1.18 ohara 252: return c;
253: }
254:
1.23 noro 255: cmo_bf* new_cmo_bf()
256: {
257: cmo_bf* c = MALLOC(sizeof(cmo_bf));
1.26 ohara 258: c->tag = CMO_BIGFLOAT32;
1.23 noro 259: mpfr_init(c->mpfr);
260: return c;
261: }
262:
1.25 noro 263: cmo_complex* new_cmo_complex()
264: {
265: cmo_complex* c = MALLOC(sizeof(cmo_complex));
266: c->tag = CMO_COMPLEX;
267: return c;
268: }
269:
1.18 ohara 270: cmo_qq* new_cmo_qq_set_mpq(mpq_ptr q)
271: {
1.22 ohara 272: cmo_qq* c = new_cmo_qq();
273: mpq_set(c->mpq, q);
1.18 ohara 274: return c;
275: }
276:
277: cmo_qq* new_cmo_qq_set_mpz(mpz_ptr num, mpz_ptr den)
278: {
1.22 ohara 279: cmo_qq* c = new_cmo_qq();
280: mpq_set_num(c->mpq, num);
281: mpq_set_den(c->mpq, den);
1.18 ohara 282: return c;
283: }
284:
1.23 noro 285: cmo_bf* new_cmo_bf_set_mpfr(mpfr_ptr num)
286: {
287: cmo_bf* c = new_cmo_bf();
288: mpfr_init2(c->mpfr,num->_mpfr_prec);
289: mpfr_set(c->mpfr,num,MPFR_RNDN);
290: return c;
291: }
292:
1.25 noro 293: cmo_complex* new_cmo_complex_set_re_im(cmo *re,cmo *im)
294: {
295: cmo_complex* c = new_cmo_complex();
296: c->re = re;
297: c->im = im;
298: return c;
299: }
300:
1.1 ohara 301: cmo_zero* new_cmo_zero()
302: {
1.13 ohara 303: cmo_zero* m = MALLOC_ATOMIC(sizeof(cmo_zero));
1.1 ohara 304: m->tag = CMO_ZERO;
1.6 ohara 305: return m;
306: }
307:
308: cmo_double *new_cmo_double(double d)
309: {
1.13 ohara 310: cmo_double* m = MALLOC_ATOMIC(sizeof(cmo_double));
1.18 ohara 311: m->tag = CMO_IEEE_DOUBLE_FLOAT;
1.6 ohara 312: m->d = d;
1.1 ohara 313: return m;
314: }
315:
316: cmo_dms_generic* new_cmo_dms_generic()
317: {
1.13 ohara 318: cmo_dms_generic* m = MALLOC_ATOMIC(sizeof(cmo_dms_generic));
1.1 ohara 319: m->tag = CMO_DMS_GENERIC;
320: return m;
321: }
322:
323: cmo_ring_by_name* new_cmo_ring_by_name(cmo* ob)
324: {
1.11 ohara 325: cmo_ring_by_name* c = MALLOC(sizeof(cmo_ring_by_name));
1.1 ohara 326: c->tag = CMO_RING_BY_NAME;
327: c->ob = ob;
328: return c;
329: }
330:
331: cmo_indeterminate* new_cmo_indeterminate(cmo* ob)
332: {
1.11 ohara 333: cmo_indeterminate* c = MALLOC(sizeof(cmo_indeterminate));
1.1 ohara 334: c->tag = CMO_INDETERMINATE;
335: c->ob = ob;
336: return c;
337: }
338:
339: cmo_distributed_polynomial* new_cmo_distributed_polynomial()
340: {
1.11 ohara 341: cmo_distributed_polynomial* c = MALLOC(sizeof(cmo_distributed_polynomial));
1.1 ohara 342: c->tag = CMO_DISTRIBUTED_POLYNOMIAL;
343: c->length = 0;
344: c->head->next = c->head;
345: c->head->prev = c->head;
346: c->ringdef = NULL;
1.14 ohara 347: return c;
348: }
349:
350: cmo_polynomial_in_one_variable* new_cmo_polynomial_in_one_variable(int var)
351: {
352: cmo_polynomial_in_one_variable* c = MALLOC(sizeof(cmo_polynomial_in_one_variable));
353: c->tag = CMO_POLYNOMIAL_IN_ONE_VARIABLE;
354: c->length = 0;
355: c->head->next = c->head;
356: c->head->prev = c->head;
357: c->var = var;
358: return c;
359: }
360:
1.15 ohara 361: cmo_recursive_polynomial* new_cmo_recursive_polynomial(cmo_list* ringdef, cmo* coef)
1.14 ohara 362: {
363: cmo_recursive_polynomial* c = MALLOC(sizeof(cmo_recursive_polynomial));
364: c->tag = CMO_RECURSIVE_POLYNOMIAL;
365: c->ringdef = ringdef;
366: c->coef = coef;
1.16 ohara 367: return c;
368: }
369:
370: cmo_tree* new_cmo_tree(cmo_string* name, cmo_list* attributes, cmo_list* leaves)
371: {
372: cmo_tree* c = MALLOC(sizeof(cmo_tree));
373: c->tag = CMO_TREE;
374: c->name= name;
375: c->attributes = attributes;
376: c->leaves = leaves;
377: return c;
378: }
379:
380: cmo_lambda* new_cmo_lambda(cmo_list* args, cmo_tree* body)
381: {
382: cmo_lambda* c = MALLOC(sizeof(cmo_lambda));
383: c->tag = CMO_LAMBDA;
384: c->args = args;
385: c->body = body;
1.1 ohara 386: return c;
387: }
388:
389: cmo_error2* new_cmo_error2(cmo* ob)
390: {
1.11 ohara 391: cmo_error2* c = MALLOC(sizeof(cmo_error2));
1.1 ohara 392: c->tag = CMO_ERROR2;
393: c->ob = ob;
394: return c;
395: }
396:
1.2 ohara 397:
398: /* Following functions translate cmo's to (asciiz) strings. */
1.1 ohara 399: static char *new_string_set_cmo_zz(cmo_zz *c)
400: {
401: return mpz_get_str(NULL, 10, c->mpz);
402: }
403:
404: static char *new_string_set_cmo_null()
405: {
406: static char* null_string = "";
407: return null_string;
408: }
409:
410: static char *new_string_set_cmo_int32(int integer)
411: {
412: char buff[1024];
413: char *s;
414:
415: sprintf(buff, "%d", integer);
1.11 ohara 416: s = MALLOC(strlen(buff)+1);
1.1 ohara 417: strcpy(s, buff);
418:
419: return s;
420: }
421:
422: static char *new_string_set_cmo_list(cmo_list *m)
423: {
424: char *s;
425: int i;
426: int size = 0;
427: int len = list_length(m);
1.11 ohara 428: char **sp = ALLOCA(len*sizeof(cmo *));
1.1 ohara 429:
430: cell* cp = list_first(m);
431: for(i = 0; i < len; i++) {
432: sp[i] = new_string_set_cmo(cp->cmo);
433: size += strlen(sp[i]) + 3;
434: cp = list_next(cp);
435: }
1.11 ohara 436: s = MALLOC(size+2);
1.1 ohara 437: strcpy(s, "[ ");
438: for(i = 0; i < len - 1; i++) {
439: strcat(s, sp[i]);
440: strcat(s, " , ");
441: }
1.17 iwane 442: if (len > 0)
443: strcat(s, sp[len-1]);
1.1 ohara 444: strcat(s, " ]");
445: return s;
446: }
447:
1.7 ohara 448: static char *new_string_set_cmo_double(cmo_double *m)
449: {
450: char buff[1024];
451: char *s;
452:
1.13 ohara 453: sprintf(buff, "%.20f", m->d);
454: s = MALLOC_ATOMIC(strlen(buff)+1);
1.7 ohara 455: strcpy(s, buff);
456:
457: return s;
458: }
459:
1.1 ohara 460: char *new_string_set_cmo(cmo *m)
461: {
462: switch(m->tag) {
463: case CMO_ZZ:
464: return new_string_set_cmo_zz((cmo_zz *)m);
465: case CMO_INT32:
466: return new_string_set_cmo_int32(((cmo_int32 *)m)->i);
467: case CMO_STRING:
468: return ((cmo_string *)m)->s;
469: case CMO_NULL:
470: return new_string_set_cmo_null();
471: case CMO_LIST:
472: return new_string_set_cmo_list((cmo_list *)m);
1.18 ohara 473: case CMO_64BIT_MACHINE_DOUBLE:
474: case CMO_IEEE_DOUBLE_FLOAT:
1.15 ohara 475: return new_string_set_cmo_double((cmo_double *)m);
1.1 ohara 476: default:
1.8 ohara 477: ox_printf("unconvertible <%s>\n", get_symbol_by_tag(m->tag));
1.1 ohara 478: /* yet not implemented. */
479: return NULL;
480: }
481: }
1.24 noro 482:
483: int cmo_to_int(cmo *n)
484: {
485: switch(n->tag) {
486: case CMO_ZERO:
487: return 0;
488: case CMO_INT32:
489: return ((cmo_int32 *)n)->i;
490: case CMO_ZZ:
491: return mpz_get_si(((cmo_zz *)n)->mpz);
492: default:
493: return 0;
494: }
495: }
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