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