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