Annotation of OpenXM/src/ox_toolkit/cmo.c, Revision 1.24
1.1 ohara 1: /* -*- mode: C; coding: euc-japan -*- */
1.24 ! noro 2: /* $OpenXM: OpenXM/src/ox_toolkit/cmo.c,v 1.23 2015/08/04 05:24:44 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.18 ohara 265: cmo_qq* new_cmo_qq_set_mpq(mpq_ptr q)
266: {
1.22 ohara 267: cmo_qq* c = new_cmo_qq();
268: mpq_set(c->mpq, q);
1.18 ohara 269: return c;
270: }
271:
272: cmo_qq* new_cmo_qq_set_mpz(mpz_ptr num, mpz_ptr den)
273: {
1.22 ohara 274: cmo_qq* c = new_cmo_qq();
275: mpq_set_num(c->mpq, num);
276: mpq_set_den(c->mpq, den);
1.18 ohara 277: return c;
278: }
279:
1.23 noro 280: cmo_bf* new_cmo_bf_set_mpfr(mpfr_ptr num)
281: {
282: cmo_bf* c = new_cmo_bf();
283: mpfr_init2(c->mpfr,num->_mpfr_prec);
284: mpfr_set(c->mpfr,num,MPFR_RNDN);
285: return c;
286: }
287:
1.1 ohara 288: cmo_zero* new_cmo_zero()
289: {
1.13 ohara 290: cmo_zero* m = MALLOC_ATOMIC(sizeof(cmo_zero));
1.1 ohara 291: m->tag = CMO_ZERO;
1.6 ohara 292: return m;
293: }
294:
295: cmo_double *new_cmo_double(double d)
296: {
1.13 ohara 297: cmo_double* m = MALLOC_ATOMIC(sizeof(cmo_double));
1.18 ohara 298: m->tag = CMO_IEEE_DOUBLE_FLOAT;
1.6 ohara 299: m->d = d;
1.1 ohara 300: return m;
301: }
302:
303: cmo_dms_generic* new_cmo_dms_generic()
304: {
1.13 ohara 305: cmo_dms_generic* m = MALLOC_ATOMIC(sizeof(cmo_dms_generic));
1.1 ohara 306: m->tag = CMO_DMS_GENERIC;
307: return m;
308: }
309:
310: cmo_ring_by_name* new_cmo_ring_by_name(cmo* ob)
311: {
1.11 ohara 312: cmo_ring_by_name* c = MALLOC(sizeof(cmo_ring_by_name));
1.1 ohara 313: c->tag = CMO_RING_BY_NAME;
314: c->ob = ob;
315: return c;
316: }
317:
318: cmo_indeterminate* new_cmo_indeterminate(cmo* ob)
319: {
1.11 ohara 320: cmo_indeterminate* c = MALLOC(sizeof(cmo_indeterminate));
1.1 ohara 321: c->tag = CMO_INDETERMINATE;
322: c->ob = ob;
323: return c;
324: }
325:
326: cmo_distributed_polynomial* new_cmo_distributed_polynomial()
327: {
1.11 ohara 328: cmo_distributed_polynomial* c = MALLOC(sizeof(cmo_distributed_polynomial));
1.1 ohara 329: c->tag = CMO_DISTRIBUTED_POLYNOMIAL;
330: c->length = 0;
331: c->head->next = c->head;
332: c->head->prev = c->head;
333: c->ringdef = NULL;
1.14 ohara 334: return c;
335: }
336:
337: cmo_polynomial_in_one_variable* new_cmo_polynomial_in_one_variable(int var)
338: {
339: cmo_polynomial_in_one_variable* c = MALLOC(sizeof(cmo_polynomial_in_one_variable));
340: c->tag = CMO_POLYNOMIAL_IN_ONE_VARIABLE;
341: c->length = 0;
342: c->head->next = c->head;
343: c->head->prev = c->head;
344: c->var = var;
345: return c;
346: }
347:
1.15 ohara 348: cmo_recursive_polynomial* new_cmo_recursive_polynomial(cmo_list* ringdef, cmo* coef)
1.14 ohara 349: {
350: cmo_recursive_polynomial* c = MALLOC(sizeof(cmo_recursive_polynomial));
351: c->tag = CMO_RECURSIVE_POLYNOMIAL;
352: c->ringdef = ringdef;
353: c->coef = coef;
1.16 ohara 354: return c;
355: }
356:
357: cmo_tree* new_cmo_tree(cmo_string* name, cmo_list* attributes, cmo_list* leaves)
358: {
359: cmo_tree* c = MALLOC(sizeof(cmo_tree));
360: c->tag = CMO_TREE;
361: c->name= name;
362: c->attributes = attributes;
363: c->leaves = leaves;
364: return c;
365: }
366:
367: cmo_lambda* new_cmo_lambda(cmo_list* args, cmo_tree* body)
368: {
369: cmo_lambda* c = MALLOC(sizeof(cmo_lambda));
370: c->tag = CMO_LAMBDA;
371: c->args = args;
372: c->body = body;
1.1 ohara 373: return c;
374: }
375:
376: cmo_error2* new_cmo_error2(cmo* ob)
377: {
1.11 ohara 378: cmo_error2* c = MALLOC(sizeof(cmo_error2));
1.1 ohara 379: c->tag = CMO_ERROR2;
380: c->ob = ob;
381: return c;
382: }
383:
1.2 ohara 384:
385: /* Following functions translate cmo's to (asciiz) strings. */
1.1 ohara 386: static char *new_string_set_cmo_zz(cmo_zz *c)
387: {
388: return mpz_get_str(NULL, 10, c->mpz);
389: }
390:
391: static char *new_string_set_cmo_null()
392: {
393: static char* null_string = "";
394: return null_string;
395: }
396:
397: static char *new_string_set_cmo_int32(int integer)
398: {
399: char buff[1024];
400: char *s;
401:
402: sprintf(buff, "%d", integer);
1.11 ohara 403: s = MALLOC(strlen(buff)+1);
1.1 ohara 404: strcpy(s, buff);
405:
406: return s;
407: }
408:
409: static char *new_string_set_cmo_list(cmo_list *m)
410: {
411: char *s;
412: int i;
413: int size = 0;
414: int len = list_length(m);
1.11 ohara 415: char **sp = ALLOCA(len*sizeof(cmo *));
1.1 ohara 416:
417: cell* cp = list_first(m);
418: for(i = 0; i < len; i++) {
419: sp[i] = new_string_set_cmo(cp->cmo);
420: size += strlen(sp[i]) + 3;
421: cp = list_next(cp);
422: }
1.11 ohara 423: s = MALLOC(size+2);
1.1 ohara 424: strcpy(s, "[ ");
425: for(i = 0; i < len - 1; i++) {
426: strcat(s, sp[i]);
427: strcat(s, " , ");
428: }
1.17 iwane 429: if (len > 0)
430: strcat(s, sp[len-1]);
1.1 ohara 431: strcat(s, " ]");
432: return s;
433: }
434:
1.7 ohara 435: static char *new_string_set_cmo_double(cmo_double *m)
436: {
437: char buff[1024];
438: char *s;
439:
1.13 ohara 440: sprintf(buff, "%.20f", m->d);
441: s = MALLOC_ATOMIC(strlen(buff)+1);
1.7 ohara 442: strcpy(s, buff);
443:
444: return s;
445: }
446:
1.1 ohara 447: char *new_string_set_cmo(cmo *m)
448: {
449: switch(m->tag) {
450: case CMO_ZZ:
451: return new_string_set_cmo_zz((cmo_zz *)m);
452: case CMO_INT32:
453: return new_string_set_cmo_int32(((cmo_int32 *)m)->i);
454: case CMO_STRING:
455: return ((cmo_string *)m)->s;
456: case CMO_NULL:
457: return new_string_set_cmo_null();
458: case CMO_LIST:
459: return new_string_set_cmo_list((cmo_list *)m);
1.18 ohara 460: case CMO_64BIT_MACHINE_DOUBLE:
461: case CMO_IEEE_DOUBLE_FLOAT:
1.15 ohara 462: return new_string_set_cmo_double((cmo_double *)m);
1.1 ohara 463: default:
1.8 ohara 464: ox_printf("unconvertible <%s>\n", get_symbol_by_tag(m->tag));
1.1 ohara 465: /* yet not implemented. */
466: return NULL;
467: }
468: }
1.24 ! noro 469:
! 470: int cmo_to_int(cmo *n)
! 471: {
! 472: switch(n->tag) {
! 473: case CMO_ZERO:
! 474: return 0;
! 475: case CMO_INT32:
! 476: return ((cmo_int32 *)n)->i;
! 477: case CMO_ZZ:
! 478: return mpz_get_si(((cmo_zz *)n)->mpz);
! 479: default:
! 480: return 0;
! 481: }
! 482: }
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