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