![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to spexpr.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / io|
Return to spexpr.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / io |
1.3 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.4 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.3 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
1.25 ! noro 47: * $OpenXM: OpenXM_contrib2/asir2000/io/spexpr.c,v 1.24 2003/06/09 16:18:10 saito Exp $
1.3 noro 48: */
1.1 noro 49: #include "ca.h"
1.2 noro 50: #include "al.h"
1.1 noro 51: #include "parse.h"
52: #include "comp.h"
53: #include "base.h"
1.25 ! noro 54: #if PARI
! 55: #include "genpari.h"
! 56: #endif
1.1 noro 57:
58: #ifndef SPRINT
59: #define SPRINT
60: #endif
61:
1.2 noro 62: #define PRINTHAT (fortran_output?PUTS("**"):PUTS("^"))
1.23 saito 63: extern int outputstyle;
1.2 noro 64:
1.1 noro 65: #ifdef FPRINT
66: FILE *asir_out;
67: #define OUT asir_out
68: char DFORMAT[BUFSIZ];
1.2 noro 69: int hex_output;
70: int fortran_output;
1.14 noro 71: int double_output;
72: int real_digit;
73: int print_quote;
1.1 noro 74:
75: #define TAIL
76: #define PUTS(s) fputs(s,OUT)
77: #define PRINTF fprintf
78: #define PRINTN printn
79: #define PRINTBF printbf
80: #define PRINTCPLX printcplx
1.2 noro 81: #define PRINTLM printlm
82: #define PRINTUP2 printup2
1.1 noro 83: #define PRINTV printv
84: #define PRINTEXPR printexpr
85: #define PRINTNUM printnum
1.20 noro 86: #define PRINTP asir_printp
1.1 noro 87: #define PRINTR printr
88: #define PRINTLIST printlist
89: #define PRINTVECT printvect
90: #define PRINTMAT printmat
91: #define PRINTSTR printstr
92: #define PRINTCOMP printcomp
93: #define PRINTDP printdp
1.2 noro 94: #define PRINTUI printui
95: #define PRINTGF2MAT printgf2mat
96: #define PRINTGFMMAT printgfmmat
1.5 noro 97: #define PRINTBYTEARRAY printbytearray
1.13 noro 98: #define PRINTQUOTE printquote
1.2 noro 99: #define PRINTERR printerr
100: #define PRINTLF printlf
101: #define PRINTLOP printlop
102: #define PRINTFOP printfop
103: #define PRINTEOP printeop
104: #define PRINTQOP printqop
105: #define PRINTUP printup
1.16 noro 106: #define PRINTUM printum
107: #define PRINTSF printsf
1.1 noro 108: #endif
109:
110: #ifdef SPRINT
111: static char *buf;
112: #define OUT buf
113: extern char DFORMAT[BUFSIZ];
1.2 noro 114: extern int hex_output;
115: extern int fortran_output;
1.6 noro 116: extern int double_output;
1.10 noro 117: extern int real_digit;
1.14 noro 118: extern int print_quote;
1.1 noro 119:
1.22 saito 120:
1.1 noro 121: #define TAIL while ( *OUT ) OUT++;
122: #define PUTS(s) strcat(OUT,s)
123: #define PRINTF sprintf
124: #define PRINTN sprintn
125: #define PRINTBF sprintbf
126: #define PRINTCPLX sprintcplx
1.2 noro 127: #define PRINTLM sprintlm
128: #define PRINTUP2 sprintup2
1.1 noro 129: #define PRINTV sprintv
130: #define PRINTEXPR sprintexpr
131: #define PRINTNUM sprintnum
1.20 noro 132: #define PRINTP asir_sprintp
1.1 noro 133: #define PRINTR sprintr
134: #define PRINTLIST sprintlist
135: #define PRINTVECT sprintvect
136: #define PRINTMAT sprintmat
137: #define PRINTSTR sprintstr
138: #define PRINTCOMP sprintcomp
139: #define PRINTDP sprintdp
1.2 noro 140: #define PRINTUI sprintui
141: #define PRINTGF2MAT sprintgf2mat
142: #define PRINTGFMMAT sprintgfmmat
1.5 noro 143: #define PRINTBYTEARRAY sprintbytearray
1.13 noro 144: #define PRINTQUOTE sprintquote
1.2 noro 145: #define PRINTERR sprinterr
146: #define PRINTLF sprintlf
147: #define PRINTLOP sprintlop
148: #define PRINTFOP sprintfop
149: #define PRINTEOP sprinteop
150: #define PRINTQOP sprintqop
151: #define PRINTUP sprintup
1.16 noro 152: #define PRINTUM sprintum
153: #define PRINTSF sprintsf
1.1 noro 154: #endif
155:
156: void PRINTEXPR();
157: void PRINTNUM();
158: void PRINTN();
159: void PRINTV();
160: void PRINTP();
161: void PRINTR();
162: void PRINTLIST();
163: void PRINTVECT();
164: void PRINTMAT();
165: void PRINTSTR();
166: void PRINTCOMP();
167: void PRINTDP();
1.2 noro 168: void PRINTUI();
169: void PRINTGF2MAT();
170: void PRINTGFMMAT();
1.5 noro 171: void PRINTBYTEARRAY();
1.13 noro 172: void PRINTQUOTE();
1.2 noro 173: void PRINTERR();
1.1 noro 174: void PRINTCPLX();
1.2 noro 175: void PRINTLM();
176: void PRINTLF();
177: void PRINTUP2();
1.17 noro 178: void PRINTUP();
179: void PRINTUM();
180: void PRINTFOP();
181: void PRINTEOP();
182: void PRINTLOP();
183: void PRINTQOP();
184: void PRINTSF();
1.1 noro 185:
186: #ifdef FPRINT
187: void output_init() {
188: OUT = stdout;
189: sprintf(DFORMAT,"%%0%dd",DLENGTH);
190: }
191:
192: int mmono(p)
193: P p;
194: {
195: if ( NUM(p) )
1.9 saito 196: #if defined(INTERVAL)
1.18 kondoh 197: if ( NID(p) != N_IP && NID(p) != N_IntervalDouble && NID(p) != N_IntervalQuad && NID(p) != N_IntervalBigFloat
1.14 noro 198: && compnum(CO,(Num)p,0) < 0 )
1.9 saito 199: #else
1.1 noro 200: if ( compnum(CO,(Num)p,0) < 0 )
1.9 saito 201: #endif
1.1 noro 202: return ( 1 );
203: else
204: return ( 0 );
205: else if ( NEXT(DC(p)) )
206: return ( 0 );
207: else
208: return (mmono(COEF(DC(p))));
209: }
210:
1.21 ohara 211: #if defined(PARI)
1.2 noro 212: void printbf(a)
1.1 noro 213: BF a;
214: {
1.7 noro 215: sor(a->body,double_output ? 'f' : 'g',-1,0);
1.1 noro 216: }
217: #endif
218: #endif
219:
220: #ifdef SPRINT
221: void soutput_init(s)
222: char *s;
223: {
224: s[0] = 0; buf = s;
225: }
226:
1.21 ohara 227: #if defined(PARI)
1.8 noro 228: void myoutbrute(g)
229: GEN g;
230: {
231: bruteall(g,'f',-1,1);
232: }
233:
1.1 noro 234: void sprintbf(a)
235: BF a;
236: {
237: char *str;
1.8 noro 238: char *GENtostr0();
1.1 noro 239:
1.8 noro 240: if ( double_output ) {
241: str = GENtostr0(a->body,myoutbrute);
242: } else {
243: str = GENtostr(a->body);
244: }
1.1 noro 245: TAIL PRINTF(OUT,"%s",str);
246: free(str);
247: }
248: #endif
249: #endif
250:
251: void PRINTEXPR(vl,p)
252: VL vl;
253: Obj p;
254: {
255: if ( !p ) {
256: PRINTR(vl,(R)p);
257: return;
258: }
259:
260: switch ( OID(p) ) {
261: case O_N:
262: PRINTNUM((Num)p); break;
263: case O_P:
264: PRINTP(vl,(P)p); break;
265: case O_R:
266: PRINTR(vl,(R)p); break;
267: case O_LIST:
268: PRINTLIST(vl,(LIST)p); break;
269: case O_VECT:
270: PRINTVECT(vl,(VECT)p); break;
271: case O_MAT:
272: PRINTMAT(vl,(MAT)p); break;
273: case O_STR:
274: PRINTSTR((STRING)p); break;
275: case O_COMP:
276: PRINTCOMP(vl,(COMP)p); break;
277: case O_DP:
278: PRINTDP(vl,(DP)p); break;
1.2 noro 279: case O_USINT:
280: PRINTUI(vl,(USINT)p); break;
281: case O_GF2MAT:
282: PRINTGF2MAT(vl,(GF2MAT)p); break;
283: case O_ERR:
284: PRINTERR(vl,(ERR)p); break;
285: case O_MATHCAP:
286: PRINTLIST(vl,((MATHCAP)p)->body); break;
287: case O_F:
288: PRINTLF(vl,(F)p); break;
289: case O_GFMMAT:
290: PRINTGFMMAT(vl,(GFMMAT)p); break;
1.5 noro 291: case O_BYTEARRAY:
292: PRINTBYTEARRAY(vl,(BYTEARRAY)p); break;
1.13 noro 293: case O_QUOTE:
294: PRINTQUOTE(vl,(QUOTE)p); break;
1.1 noro 295: default:
296: break;
297: }
298: }
299:
300: void PRINTN(n)
301: N n;
302: {
303: register int i,*ptr;
304: N tn;
305:
306: if ( !n ) {
307: PUTS("0");
308: return;
309: }
1.2 noro 310: if ( hex_output ) {
311: ptr = BD(n);
312: TAIL PRINTF(OUT,"0x%x",ptr[PL(n)-1]);
313: if ( hex_output < 0 )
314: for ( i = PL(n) - 2; i >= 0; i-- ) {
315: TAIL PRINTF(OUT,"|%08x",ptr[i]);
316: }
317: else
318: for ( i = PL(n) - 2; i >= 0; i-- ) {
319: TAIL PRINTF(OUT,"%08x",ptr[i]);
320: }
321: } else {
322: ntobn(DBASE,n,&tn);
323: ptr = BD(tn);
324: TAIL PRINTF(OUT,"%d",ptr[PL(tn) - 1]);
325: for ( i = PL(tn) - 2; i >= 0; i-- ) {
326: TAIL PRINTF(OUT,DFORMAT,ptr[i]);
327: }
1.1 noro 328: }
329: }
330:
1.15 noro 331: #if defined(FPRINT)
332: #if defined(ITVDEBUG)
333: void printbin(double z)
334: {
335: int i, j, mask;
336: union {
337: double x;
338: char c[8];
339: } a;
340:
341: a.x = z;
342: for(i=7;i>=0;i--) {
343: mask = 0x80;
344: for(j=0;j<8;j++) {
345: if (a.c[i] & mask) fprintf(stderr,"1");
346: else fprintf(stderr,"0");
347: mask >>= 1;
348: }
349: }
350: fprintf(stderr,"\n");
351: }
352: #endif
353: #endif
354:
355: #if defined(FPRINT)
356: #if 0
357: int printmode = PRINTF_E;
358: #else
359: int printmode = PRINTF_G;
360: #endif
361: #else
362: extern int printmode;
363: #endif
1.9 saito 364:
1.1 noro 365: void PRINTNUM(q)
366: Num q;
367: {
1.10 noro 368: char real_format[20];
369:
1.1 noro 370: if ( !q ) {
371: PUTS("0");
372: return;
373: }
374: switch ( NID(q) ) {
375: case N_Q:
376: if ( SGN((Q)q) == -1 )
377: PUTS("-");
378: PRINTN(NM((Q)q));
379: if ( !INT((Q)q) ) {
380: PUTS("/"); PRINTN(DN((Q)q));
381: }
382: break;
383: case N_R:
1.9 saito 384: switch (printmode) {
385: case PRINTF_E:
386: #if defined(INTERVAL)
387: case MID_PRINTF_E:
388: #endif
1.14 noro 389: TAIL PRINTF(OUT,"%.16e",BDY((Real)q));
1.9 saito 390: break;
391: case PRINTF_G:
392: #if defined(INTERVAL)
393: case MID_PRINTF_G:
394: #endif
395: default:
1.14 noro 396: if ( real_digit ) {
397: sprintf(real_format,
398: double_output?"%%.%df":"%%.%dg",real_digit);
399: TAIL PRINTF(OUT,real_format,BDY((Real)q));
400: } else {
401: TAIL PRINTF(OUT,double_output?"%f":"%g",BDY((Real)q));
402: }
403: break;
1.9 saito 404: }
1.1 noro 405: break;
406: case N_A:
407: PUTS("("); PRINTR(ALG,(R)BDY((Alg)q)); PUTS(")");
408: break;
1.21 ohara 409: #if defined(PARI)
1.1 noro 410: case N_B:
411: PRINTBF((BF)q); break;
1.9 saito 412: #endif
413: #if defined(INTERVAL)
414: case N_IP:
1.18 kondoh 415: case N_IntervalBigFloat:
1.23 saito 416: switch ( outputstyle ) {
417: case 1:
418: PUTS("intval(");
419: PRINTNUM(INF((Itv)q));
420: PUTS(",");
421: PRINTNUM(SUP((Itv)q));
422: PUTS(")");
423: break;
1.24 saito 424: case 0:
1.23 saito 425: default:
426: PUTS("[");
427: PRINTNUM(INF((Itv)q));
428: PUTS(",");
429: PRINTNUM(SUP((Itv)q));
430: PUTS("]");
431: break;
1.22 saito 432: }
1.9 saito 433: break;
1.18 kondoh 434: case N_IntervalDouble:
1.9 saito 435: switch (printmode) {
436: case PRINTF_E:
1.23 saito 437: switch ( outputstyle ) {
438: case 1:
439: TAIL PRINTF(OUT, "intval(%.16e,%.16e)",
440: INF((IntervalDouble)q),SUP((IntervalDouble)q));
441: break;
1.24 saito 442: case 0:
1.23 saito 443: default:
444: TAIL PRINTF(OUT, "[%.16e,%.16e]",
445: INF((IntervalDouble)q),SUP((IntervalDouble)q));
446: break;
1.22 saito 447: }
1.9 saito 448: #if defined(ITVDEBUG)
1.18 kondoh 449: printbin(INF((IntervalDouble)q));
450: printbin(SUP((IntervalDouble)q));
1.9 saito 451: #endif
452: break;
453: case MID_PRINTF_G:
1.23 saito 454: switch ( outputstyle ) {
455: case 1:
456: TAIL PRINTF(OUT, "intvalm(%g,%g)",
457: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
458: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
459: break;
1.24 saito 460: case 0:
1.23 saito 461: default:
462: TAIL PRINTF(OUT, "<%g,%g>",
463: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
464: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
465: break;
1.22 saito 466: }
1.9 saito 467: break;
468: case MID_PRINTF_E:
1.23 saito 469: switch ( outputstyle ) {
470: case 1:
471: TAIL PRINTF(OUT, "intvalm(%.16e,%.16e)",
472: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
473: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
474: break;
1.24 saito 475: case 0:
1.23 saito 476: default:
477: TAIL PRINTF(OUT, "<%.16e,%.16e>",
478: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
479: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
480: break;
1.22 saito 481: }
1.9 saito 482: break;
483: case PRINTF_G:
484: default:
1.23 saito 485: switch ( outputstyle ) {
486: case 1:
487: TAIL PRINTF(OUT, "intval(%g,%g)",
488: INF((IntervalDouble)q),SUP((IntervalDouble)q));
489: break;
1.24 saito 490: case 0:
1.23 saito 491: default:
492: TAIL PRINTF(OUT, "[%g,%g]",
493: INF((IntervalDouble)q),SUP((IntervalDouble)q));
494: break;
1.22 saito 495: }
1.9 saito 496: break;
497: }
498: break;
1.1 noro 499: #endif
500: case N_C:
501: PRINTCPLX((C)q); break;
502: case N_M:
1.2 noro 503: TAIL PRINTF(OUT,"%d",CONT((MQ)q)); break;
504: case N_LM:
505: PRINTN(((LM)q)->body); break;
506: case N_GF2N:
507: if ( hex_output )
508: PRINTN((N)(((GF2N)q)->body));
509: else
510: PRINTUP2(((GF2N)q)->body);
511: break;
512: case N_GFPN:
513: PRINTUP((UP)(((GFPN)q)->body));
1.1 noro 514: break;
1.11 noro 515: case N_GFS:
1.14 noro 516: TAIL PRINTF(OUT,"@_%d",CONT((GFS)q));
517: break;
1.16 noro 518: case N_GFSN:
519: PRINTUM(BDY((GFSN)q));
520: break;
1.1 noro 521: }
522: }
523:
524: void PRINTCPLX(a)
525: C a;
526: {
527: PUTS("(");
528: if ( a->r )
529: PRINTNUM(a->r);
530: if ( a->i ) {
1.14 noro 531: #if defined(INTERVAL)
532: if ( a->r && ((compnum(0,a->i,0) > 0)
1.18 kondoh 533: || NID(a->i) == N_IP || NID(a->i) == N_IntervalDouble
534: || NID(a->i) == N_IntervalQuad || NID(a->i) == N_IntervalBigFloat) )
1.14 noro 535: #else
1.1 noro 536: if ( a->r && (compnum(0,a->i,0) > 0) )
1.14 noro 537: #endif
1.1 noro 538: PUTS("+");
539: PRINTNUM(a->i); PUTS("*@i");
540: }
541: PUTS(")");
542: }
543:
544: void PRINTP(vl,p)
545: VL vl;
546: P p;
547: {
548: V v;
549: DCP dc;
550:
551: if ( !p )
552: PUTS("0");
553: else if ( NUM(p) )
554: PRINTNUM((Num)p);
555: else
556: for ( dc = DC(p), v = VR(p); dc; dc = NEXT(dc) ) {
557: if ( !DEG(dc) )
558: PRINTP(vl,COEF(dc));
559: else {
560: if ( NUM(COEF(dc)) && UNIQ((Q)COEF(dc)) ) {
561: ;
562: } else if ( NUM(COEF(dc)) && MUNIQ((Q)COEF(dc)) )
563: PUTS("-");
564: else if ( NUM(COEF(dc)) || !NEXT(DC(COEF(dc)))) {
565: PRINTP(vl,COEF(dc)); PUTS("*");
566: } else {
567: PUTS("("); PRINTP(vl,COEF(dc)); PUTS(")*");
568: }
569: PRINTV(vl,v);
570: if ( cmpq(DEG(dc),ONE) ) {
1.2 noro 571: PRINTHAT;
1.1 noro 572: if ( INT(DEG(dc)) && SGN(DEG(dc))>0 )
573: PRINTNUM((Num)DEG(dc));
574: else {
575: PUTS("("); PRINTNUM((Num)DEG(dc)); PUTS(")");
576: }
577: }
578: }
579: if ( NEXT(dc) ) {
580: P t;
581:
582: t = COEF(NEXT(dc));
583: if (!DEG(NEXT(dc))) {
584: if ( NUM(t) ) {
585: if ( !mmono(t) )
586: PUTS("+");
587: } else {
588: if (!mmono(COEF(DC(t))))
589: PUTS("+");
590: }
591: } else {
592: if ( !mmono(t) )
593: PUTS("+");
594: }
595: }
596: }
597: }
598:
1.2 noro 599: int hideargs;
600:
1.1 noro 601: void PRINTV(vl,v)
602: VL vl;
603: V v;
604: {
605: PF pf;
606: PFAD ad;
607: int i;
608:
609: if ( NAME(v) )
610: PUTS(NAME(v));
611: else if ( (vid)v->attr == V_PF ) {
612: pf = ((PFINS)v->priv)->pf; ad = ((PFINS)v->priv)->ad;
613: if ( !strcmp(NAME(pf),"pow") ) {
1.19 noro 614: PUTS("(("); PRINTR(vl,(R)ad[0].arg); PUTS(")"); PRINTHAT; PUTS("(");
615: PRINTR(vl,(R)ad[1].arg); PUTS("))");
1.1 noro 616: } else if ( !pf->argc ) {
617: TAIL PRINTF(OUT,"%s",NAME(pf));
618: } else {
1.2 noro 619: if ( hideargs ) {
620: for ( i = 0; i < pf->argc; i++ )
621: if ( ad[i].d )
622: break;
623: if ( i < pf->argc ) {
624: TAIL PRINTF(OUT,"%s{%d",NAME(pf),ad[0].d);
625: for ( i = 1; i < pf->argc; i++ ) {
626: TAIL PRINTF(OUT,",%d",ad[i].d);
627: }
628: PUTS("}");
629: } else {
630: TAIL PRINTF(OUT,"%s",NAME(pf));
631: }
632: } else {
633: for ( i = 0; i < pf->argc; i++ )
634: if ( ad[i].d )
635: break;
636: if ( i < pf->argc ) {
637: TAIL PRINTF(OUT,"%s{%d",NAME(pf),ad[0].d);
638: for ( i = 1; i < pf->argc; i++ ) {
639: TAIL PRINTF(OUT,",%d",ad[i].d);
640: }
641: PUTS("}(");
642: } else {
643: TAIL PRINTF(OUT,"%s(",NAME(pf));
644: }
645: PRINTR(vl,(R)ad[0].arg);
1.1 noro 646: for ( i = 1; i < pf->argc; i++ ) {
1.2 noro 647: PUTS(","); PRINTR(vl,(R)ad[i].arg);
1.1 noro 648: }
1.2 noro 649: PUTS(")");
1.1 noro 650: }
651: }
652: }
653: }
654:
655: void PRINTR(vl,a)
656: VL vl;
657: R a;
658: {
659: if ( !a )
660: PUTS("0");
661: else
662: switch (OID(a)) {
663: case O_N: case O_P:
664: PRINTP(vl,(P)a); break;
665: default:
666: PUTS("("); PRINTP(vl,NM((R)a)); PUTS(")/("); PRINTP(vl,DN((R)a)); PUTS(")");
667: break;
668: }
669: }
670:
671: void PRINTVECT(vl,vect)
672: VL vl;
673: VECT vect;
674: {
675: int i;
676: pointer *ptr;
677:
1.23 saito 678: switch ( outputstyle ) {
679: case 1:
680: PUTS("vect(");
681: for ( i = 0, ptr = BDY(vect); i < vect->len; i++ ) {
1.24 saito 682: if ( i != 0 ) PUTS(",");
1.23 saito 683: PRINTEXPR(vl,ptr[i]);
684: }
685: PUTS(")");
686: break;
1.24 saito 687: case 0:
1.23 saito 688: default:
689: PUTS("[ ");
690: for ( i = 0, ptr = BDY(vect); i < vect->len; i++ ) {
691: PRINTEXPR(vl,ptr[i]); PUTS(" ");
692: }
693: PUTS("]");
694: break;
1.1 noro 695: }
696: }
697:
698: void PRINTMAT(vl,mat)
699: VL vl;
700: MAT mat;
701: {
702: int i,j,r,c;
703: pointer *ptr;
704:
1.23 saito 705: switch ( outputstyle ) {
706: case 1:
707: PUTS("mat(\n");
708: for ( i = 0, r = mat->row, c = mat->col; i < r; i++ ) {
709: if ( i != 0 ) PUTS(",\n");
710: PUTS("[ ");
711: for ( j = 0, ptr = BDY(mat)[i]; j < c; j++ ) {
1.24 saito 712: if ( j != 0 ) PUTS(",");
1.23 saito 713: PRINTEXPR(vl,ptr[j]);
714: }
1.24 saito 715: PUTS(" ]");
1.22 saito 716: }
1.23 saito 717: PUTS(")");
718: break;
1.24 saito 719: case 0:
1.23 saito 720: default:
721: for ( i = 0, r = mat->row, c = mat->col; i < r; i++ ) {
722: PUTS("[ ");
723: for ( j = 0, ptr = BDY(mat)[i]; j < c; j++ ) {
724: PRINTEXPR(vl,ptr[j]); PUTS(" ");
725: }
726: PUTS("]");
727: if ( i < r - 1 )
728: PUTS("\n");
1.22 saito 729: }
1.23 saito 730: break;
1.1 noro 731: }
732: }
733:
734: void PRINTLIST(vl,list)
735: VL vl;
736: LIST list;
737: {
738: NODE tnode;
739:
740: PUTS("[");
741: for ( tnode = (NODE)list->body; tnode; tnode = NEXT(tnode) ) {
742: PRINTEXPR(vl,tnode->body);
743: if ( NEXT(tnode) )
744: PUTS(",");
745: }
746: PUTS("]");
747: }
748:
749: void PRINTSTR(str)
750: STRING str;
751: {
752: char *p;
753:
754: for ( p = BDY(str); *p; p++ )
755: if ( *p == '"' )
756: PUTS("\"");
757: else {
758: TAIL PRINTF(OUT,"%c",*p);
759: }
760: }
761:
762: void PRINTCOMP(vl,c)
763: VL vl;
764: COMP c;
765: {
766: int n,i;
767:
768: n = getcompsize((int)c->type);
769: PUTS("{");
770: for ( i = 0; i < n; i++ ) {
771: PRINTEXPR(vl,(pointer)c->member[i]);
772: if ( i < n-1 )
773: PUTS(",");
774: }
775: PUTS("}");
776: }
777:
778: void PRINTDP(vl,d)
779: VL vl;
780: DP d;
781: {
782: int n,i;
783: MP m;
784: DL dl;
785:
786: for ( n = d->nv, m = BDY(d); m; m = NEXT(m) ) {
787: PUTS("("); PRINTEXPR(vl,(pointer)m->c); PUTS(")*<<");
788: for ( i = 0, dl = m->dl; i < n-1; i++ ) {
789: TAIL PRINTF(OUT,"%d,",dl->d[i]);
790: }
791: TAIL PRINTF(OUT,"%d",dl->d[i]);
792: PUTS(">>");
793: if ( NEXT(m) )
794: PUTS("+");
1.2 noro 795: }
796: }
797:
798: void PRINTUI(vl,u)
799: VL vl;
800: USINT u;
801: {
802: TAIL PRINTF(OUT,"%u",BDY(u));
803: }
804:
805: void PRINTGF2MAT(vl,mat)
806: VL vl;
807: GF2MAT mat;
808: {
809: int row,col,w,i,j,k,m;
810: unsigned int t;
811: unsigned int **b;
812:
813: row = mat->row;
814: col = mat->col;
815: w = (col+BSH-1)/BSH;
816: b = mat->body;
817: for ( i = 0; i < row; i++ ) {
818: for ( j = 0, m = 0; j < w; j++ ) {
819: t = b[i][j];
820: for ( k = 0; m < col && k < BSH; k++, m++ )
821: if ( t & (1<<k) )
822: PUTS("1");
823: else
824: PUTS("0");
825: }
826: PUTS("\n");
827: }
828: }
829:
830: void PRINTGFMMAT(vl,mat)
831: VL vl;
832: GFMMAT mat;
833: {
834: int row,col,i,j;
835: unsigned int **b;
836:
837: row = mat->row;
838: col = mat->col;
839: b = mat->body;
840: for ( i = 0; i < row; i++ ) {
841: PUTS("[");
842: for ( j = 0; j < col; j++ ) {
843: TAIL PRINTF(OUT,"%8d",b[i][j]);
844: }
845: PUTS("]\n");
846: }
1.5 noro 847: }
848:
849: void PRINTBYTEARRAY(vl,array)
850: VL vl;
851: BYTEARRAY array;
852: {
853: int len,i;
854: unsigned char *b;
855:
856: len = array->len;
1.8 noro 857: b = array->body;
1.5 noro 858: PUTS("|");
859: for ( i = 0; i < len-1; i++ ) {
1.8 noro 860: TAIL PRINTF(OUT,"%02x ",(unsigned int)b[i]);
1.5 noro 861: }
1.8 noro 862: TAIL PRINTF(OUT,"%02x",(unsigned int)b[i]);
1.5 noro 863: PUTS("|");
1.13 noro 864: }
865:
866: void PRINTQUOTE(vl,quote)
867: VL vl;
868: QUOTE quote;
869: {
1.15 noro 870: LIST list;
871:
872: if ( print_quote ) {
873: fnodetotree(BDY(quote),&list);
874: PRINTEXPR(vl,(Obj)list);
875: } else {
876: PUTS("<...quoted...>");
877: }
1.2 noro 878: }
879:
880: void PRINTERR(vl,e)
881: VL vl;
882: ERR e;
883: {
884: PUTS("error("); PRINTEXPR(vl,e->body); PUTS(")");
885: }
886:
887: void PRINTUP2(p)
888: UP2 p;
889: {
890: int d,i;
891:
892: if ( !p ) {
893: TAIL PRINTF(OUT,"0");
894: } else {
895: d = degup2(p);
896: TAIL PRINTF(OUT,"(");
897: if ( !d ) {
898: TAIL PRINTF(OUT,"1");
899: } else if ( d == 1 ) {
900: TAIL PRINTF(OUT,"@");
901: } else {
902: PUTS("@"); PRINTHAT; TAIL PRINTF(OUT,"%d",d);
903: }
904: for ( i = d-1; i >= 0; i-- ) {
905: if ( p->b[i/BSH] & (1<<(i%BSH)) )
906: if ( !i ) {
907: TAIL PRINTF(OUT,"+1");
908: } else if ( i == 1 ) {
909: TAIL PRINTF(OUT,"+@");
910: } else {
911: PUTS("+@"); PRINTHAT; TAIL PRINTF(OUT,"%d",i);
912: }
913: }
914: TAIL PRINTF(OUT,")");
915: }
916: }
917:
918: void PRINTLF(vl,f)
919: VL vl;
920: F f;
921: {
922: switch ( FOP(f) ) {
923: case AL_TRUE:
924: TAIL PRINTF(OUT,"@true");
925: break;
926: case AL_FALSE:
927: TAIL PRINTF(OUT,"@false");
928: break;
929:
930: case AL_OR: case AL_AND:
931: PRINTFOP(vl,f); break;
932: case AL_NOT: case AL_IMPL: case AL_REPL: case AL_EQUIV:
933: PRINTEOP(vl,f); break;
934:
935: case AL_EQUAL: case AL_NEQ: case AL_LESSP:
936: case AL_GREATERP: case AL_LEQ: case AL_GEQ:
937: PRINTLOP(vl,f); break;
938:
939: case AL_EX: case AL_ALL:
940: PRINTQOP(vl,f); break;
941: default:
942: break;
943: }
944: }
945:
1.17 noro 946: void PRINTFOP(vl,f)
1.2 noro 947: VL vl;
948: F f;
949: {
950: char *op;
951: NODE n;
952:
953: op = FOP(f)==AL_OR?" @|| ":" @&& ";
954: n = FJARG(f);
955: PUTS("("); PRINTEXPR(vl,BDY(n)); PUTS(")");
956: for ( n = NEXT(n); n; n = NEXT(n) ) {
957: PUTS(op); PUTS("("); PRINTEXPR(vl,BDY(n)); PUTS(")");
958: }
959: }
960:
1.17 noro 961: void PRINTEOP(vl,f)
1.2 noro 962: VL vl;
963: F f;
964: {
965: oFOP op;
966: char *sop;
967:
968: if ( (op = FOP(f)) == AL_NOT ) {
969: PUTS("(@! "); PRINTEXPR(vl,(Obj)FARG(f)); PUTS(")"); return;
970: }
971: switch ( op ) {
972: case AL_IMPL:
973: sop = " @impl "; break;
974: case AL_REPL:
975: sop = " @repl "; break;
976: case AL_EQUIV:
977: sop = " @equiv "; break;
978: default:
979: break;
980: }
981: PUTS("(");
982: PRINTEXPR(vl,(Obj)FLHS(f));
983: PUTS(sop);
984: PRINTEXPR(vl,(Obj)FRHS(f));
985: PUTS(")");
986: }
987:
1.17 noro 988: void PRINTLOP(vl,f)
1.2 noro 989: VL vl;
990: F f;
991: {
992: char *op;
993:
994: switch ( FOP(f) ) {
995: case AL_EQUAL:
996: op = " @== "; break;
997: case AL_NEQ:
998: op = " @!= "; break;
999: case AL_LESSP:
1000: op = " @< "; break;
1001: case AL_GREATERP:
1002: op = " @> "; break;
1003: case AL_LEQ:
1004: op = " @<= "; break;
1005: case AL_GEQ:
1006: op = " @>= "; break;
1007: default:
1008: error("PRINTLOP : invalid operator");
1009: break;
1010: }
1011: PRINTEXPR(vl,(Obj)FPL(f)); PUTS(op); PUTS("0");
1012: }
1013:
1.17 noro 1014: void PRINTQOP(vl,f)
1.2 noro 1015: VL vl;
1016: F f;
1017: {
1018: char *op;
1019:
1020: op = FOP(f)==AL_EX?"ex":"all";
1021: TAIL PRINTF(OUT,"%s(%s,",op,NAME(FQVR(f)));
1022: PRINTEXPR(vl,(Obj)FQMAT(f)); PUTS(")");
1023: }
1024:
1.17 noro 1025: void PRINTUP(n)
1.2 noro 1026: UP n;
1027: {
1028: int i,d;
1029:
1030: if ( !n )
1031: PUTS("0");
1032: else if ( !n->d )
1033: PRINTNUM(n->c[0]);
1034: else {
1035: d = n->d;
1036: PUTS("(");
1037: if ( !d ) {
1038: PRINTNUM(n->c[d]);
1039: } else if ( d == 1 ) {
1040: PRINTNUM(n->c[d]);
1041: PUTS("*@p");
1042: } else {
1043: PRINTNUM(n->c[d]);
1044: PUTS("*@p"); PRINTHAT; TAIL PRINTF(OUT,"%d",d);
1045: }
1046: for ( i = d-1; i >= 0; i-- ) {
1047: if ( n->c[i] ) {
1048: PUTS("+("); PRINTNUM(n->c[i]); PUTS(")");
1049: if ( i >= 2 ) {
1050: PUTS("*@p"); PRINTHAT; TAIL PRINTF(OUT,"%d",i);
1051: } else if ( i == 1 )
1052: PUTS("*@p");
1053: }
1054: }
1055: PUTS(")");
1.16 noro 1056: }
1057: }
1058:
1.17 noro 1059: void PRINTUM(n)
1.16 noro 1060: UM n;
1061: {
1062: int i,d;
1063:
1064: if ( !n )
1065: PUTS("0");
1066: else if ( !n->d )
1067: PRINTSF(n->c[0]);
1068: else {
1069: d = n->d;
1070: PUTS("(");
1071: if ( !d ) {
1072: PRINTSF(n->c[d]);
1073: } else if ( d == 1 ) {
1074: PRINTSF(n->c[d]);
1075: PUTS("*@s");
1076: } else {
1077: PRINTSF(n->c[d]);
1078: PUTS("*@s"); PRINTHAT; TAIL PRINTF(OUT,"%d",d);
1079: }
1080: for ( i = d-1; i >= 0; i-- ) {
1081: if ( n->c[i] ) {
1082: PUTS("+("); PRINTSF(n->c[i]); PUTS(")");
1083: if ( i >= 2 ) {
1084: PUTS("*@s"); PRINTHAT; TAIL PRINTF(OUT,"%d",i);
1085: } else if ( i == 1 )
1086: PUTS("*@s");
1087: }
1088: }
1089: PUTS(")");
1090: }
1091: }
1092:
1.17 noro 1093: void PRINTSF(i)
1.16 noro 1094: unsigned int i;
1095: {
1096: if ( !i ) {
1097: PUTS("0");
1098: } else {
1099: TAIL PRINTF(OUT,"@_%d",IFTOF(i));
1.1 noro 1100: }
1101: }