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