Annotation of OpenXM_contrib2/asir2000/builtin/strobj.c, Revision 1.21
1.6 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.7 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.6 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.
47: *
1.21 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.20 2004/03/04 12:28:14 noro Exp $
1.6 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "parse.h"
52: #include "ctype.h"
1.10 ohara 53: #if defined(PARI)
1.1 noro 54: #include "genpari.h"
1.11 saito 55: # if !(PARI_VERSION_CODE > 131588)
1.1 noro 56: extern jmp_buf environnement;
1.11 saito 57: # endif
1.1 noro 58: #endif
1.5 noro 59: #include <string.h>
60:
1.18 noro 61: struct TeXSymbol {
62: char *text;
63: char *symbol;
64: };
65:
1.1 noro 66: extern char *parse_strp;
67:
68: void Prtostr(), Pstrtov(), Peval_str();
1.3 noro 69: void Pstrtoascii(), Pasciitostr();
1.5 noro 70: void Pstr_len(), Pstr_chr(), Psub_str();
1.14 noro 71: void Pwrite_to_tb();
72: void Ptb_to_string();
73: void Pclear_tb();
74: void Pstring_to_tb();
75: void Pquotetotex_tb();
76: void Pquotetotex();
1.18 noro 77: void Pquotetotex_setenv();
1.14 noro 78: void fnodetotex_tb(FNODE f,TB tb);
79: char *symbol_name(char *name);
80: void tb_to_string(TB tb,STRING *rp);
81: void fnodenodetotex_tb(NODE n,TB tb);
82: void fargstotex_tb(char *opname,FNODE f,TB tb);
1.1 noro 83:
84: struct ftab str_tab[] = {
85: {"rtostr",Prtostr,1},
86: {"strtov",Pstrtov,1},
87: {"eval_str",Peval_str,1},
1.3 noro 88: {"strtoascii",Pstrtoascii,1},
89: {"asciitostr",Pasciitostr,1},
1.5 noro 90: {"str_len",Pstr_len,1},
91: {"str_chr",Pstr_chr,3},
92: {"sub_str",Psub_str,3},
1.14 noro 93: {"write_to_tb",Pwrite_to_tb,2},
94: {"clear_tb",Pclear_tb,1},
95: {"tb_to_string",Ptb_to_string,1},
96: {"string_to_tb",Pstring_to_tb,1},
97: {"quotetotex_tb",Pquotetotex_tb,2},
98: {"quotetotex",Pquotetotex,1},
1.18 noro 99: {"quotetotex_setenv",Pquotetotex_setenv,-99999999},
1.1 noro 100: {0,0,0},
101: };
1.13 noro 102:
1.14 noro 103: void write_tb(char *s,TB tb)
104: {
105: if ( tb->next == tb->size ) {
106: tb->size *= 2;
107: tb->body = (char **)REALLOC(tb->body,tb->size*sizeof(char *));
108: }
109: tb->body[tb->next] = s;
110: tb->next++;
111: }
1.13 noro 112:
1.18 noro 113: int register_symbol_table(Obj arg);
114: int register_conv_rule(Obj arg);
115: static struct TeXSymbol *user_texsymbol;
1.19 noro 116: static char *(*conv_rule)(char *);
1.18 noro 117:
118: static struct {
119: char *name;
120: Obj value;
121: int (*reg)();
122: } qtot_env[] = {
123: {"symbol_table",0,register_symbol_table},
124: {"conv_rule",0,register_conv_rule},
125: {0,0,0},
126: };
127:
1.20 noro 128: #define PARTIAL "\\partial"
1.19 noro 129: char *conv_rule_d(char *name)
130: {
1.20 noro 131: int l,i,j,alpha,start;
132: char *b,*r;
133: l = strlen(name);
1.19 noro 134:
1.20 noro 135: if ( name[0] == 'd' ) {
136: /* 3 : _{} */
137: b = (char *)ALLOCA((2*l+1+strlen(PARTIAL)+3)*sizeof(char));
138: sprintf(b,"%s_{",PARTIAL);
139: i = 1;
140: j = strlen(b);
141: } else {
142: b = (char *)ALLOCA((2*l+1)*sizeof(char));
143: i = j = 0;
144: }
145: for ( ; i < l && name[i] == '_'; i++);
146: for ( ; i < l; ) {
147: if ( !isalpha(name[i]) )
148: break;
149: else
150: b[j++] = name[i++];
151: }
1.21 ! noro 152: if ( i == l )
! 153: if ( name[0] == 'd' )
! 154: goto END;
! 155: else
! 156: return name;
1.20 noro 157: /* we found a digit or '_' */
158: b[j++] = '_'; b[j++] = '{';
159: if ( name[i] == '_' ) i++;
160: for ( start = 1; i < l; ) {
161: if ( name[i] == '_' ) {
162: i++;
163: start = 1;
164: b[j++] = ',';
165: } else if ( start ) {
166: alpha = isalpha(name[i])?1:0;
167: b[j++] = name[i++];
168: start = 0;
169: } else if ( alpha ) {
170: if ( isalpha(name[i]) )
171: b[j++] = name[i++];
172: else {
173: alpha = 0;
174: start = 1;
175: b[j++] = ',';
176: }
1.19 noro 177: } else {
1.20 noro 178: if ( isdigit(name[i]) )
179: b[j++] = name[i++];
180: else {
181: alpha = 1;
182: start = 1;
183: b[j++] = ',';
184: }
1.19 noro 185: }
1.20 noro 186: }
187: b[j++] = '}';
1.21 ! noro 188: END:
1.20 noro 189: if ( name[0] == 'd' ) b[j++] = '}';
190: b[j++] = 0;
191: r = (char *)MALLOC_ATOMIC((j+1)*sizeof(char));
192: strcpy(r,b);
193: return r;
1.19 noro 194: }
195:
1.18 noro 196: int register_symbol_table(Obj arg)
197: {
198: NODE n,t;
199: Obj b;
200: STRING a0,a1;
201: struct TeXSymbol *uts;
202: int i,len;
203:
204: /* check */
205: if ( !arg ) {
206: user_texsymbol = 0;
207: return 1;
208: }
209: if ( OID(arg) != O_LIST ) return 0;
210:
211: n = BDY((LIST)arg);
212: len = length(n);
213: uts = (struct TeXSymbol *)MALLOC((len+1)*sizeof(struct TeXSymbol));
214: for ( i = 0; n; n = NEXT(n), i++ ) {
215: b = (Obj)BDY(n);
216: if ( !b || OID(b) != O_LIST ) return 0;
217: t = BDY((LIST)b);
218: if ( !t || !NEXT(t) ) return 0;
219: a0 = (STRING)BDY(t);
220: a1 = (STRING)BDY(NEXT(t));
221: if ( !a0 || OID(a0) != O_STR ) return 0;
222: if ( !a1 || OID(a1) != O_STR ) return 0;
223: uts[i].text = BDY(a0);
224: uts[i].symbol = BDY(a1);
225: }
226: uts[i].text = 0;
227: uts[i].symbol = 0;
228: user_texsymbol = uts;
229: return 1;
230: }
231:
232: int register_conv_rule(Obj arg)
233: {
1.19 noro 234: if ( INT(arg) ) {
235: switch ( QTOS((Q)arg) ) {
236: case 0:
237: conv_rule = 0;
238: return 1;
239: break;
240: case 1:
241: conv_rule = conv_rule_d;
242: return 1;
243: break;
244: default:
245: return 0;
246: break;
247: }
248: } else return 0;
1.18 noro 249: }
250:
251: void Pquotetotex_setenv(NODE arg,Obj *rp)
252: {
253: int ac,i;
254: char *name;
255: NODE n,n0;
256: STRING s;
257: LIST l;
258:
259: ac = argc(arg);
260: if ( !ac ) {
261: n0 = 0;
262: for ( i = 0; qtot_env[i].name; i++ ) {
263: NEXTNODE(n0,n); MKSTR(s,qtot_env[i].name); BDY(n) = (pointer)s;
264: NEXTNODE(n0,n); BDY(n) = (Q)qtot_env[i].value;
265: }
266: NEXT(n) = 0;
267: MKLIST(l,n0);
268: *rp = (Obj)l;
269: } else if ( ac == 1 || ac == 2 ) {
270: asir_assert(ARG0(arg),O_STR,"quotetotex_setenv");
271: name = BDY((STRING)ARG0(arg));
272: for ( i = 0; qtot_env[i].name; i++ )
273: if ( !strcmp(qtot_env[i].name,name) ) {
274: if ( ac == 2 ) {
275: if ( (qtot_env[i].reg)((Obj)ARG1(arg)) )
276: qtot_env[i].value = (Obj)ARG1(arg);
277: else
278: error("quotetotex_setenv : invalid argument");
279: }
280: *rp = qtot_env[i].value;
281: return;
282: }
283: *rp = 0;
284: } else
285: *rp = 0;
286: }
287:
1.14 noro 288: void Pwrite_to_tb(NODE arg,Q *rp)
1.13 noro 289: {
290: int i;
1.16 noro 291: Obj obj;
292: TB tb;
1.13 noro 293:
1.14 noro 294: asir_assert(ARG1(arg),O_TB,"write_to_tb");
1.16 noro 295: obj = ARG0(arg);
296: if ( !obj )
297: write_tb("",ARG1(arg));
298: else if ( OID(obj) == O_STR )
299: write_tb(BDY((STRING)obj),ARG1(arg));
300: else if ( OID(obj) == O_TB ) {
301: tb = (TB)obj;
302: for ( i = 0; i < tb->next; i++ )
303: write_tb(tb->body[i],ARG1(arg));
304: }
1.14 noro 305: *rp = 0;
1.13 noro 306: }
307:
1.14 noro 308: void Pquotetotex(NODE arg,STRING *rp)
1.13 noro 309: {
1.14 noro 310: TB tb;
1.13 noro 311:
1.14 noro 312: NEWTB(tb);
313: fnodetotex_tb(BDY((QUOTE)ARG0(arg)),tb);
314: tb_to_string(tb,rp);
1.13 noro 315: }
316:
1.14 noro 317: void Pquotetotex_tb(NODE arg,Q *rp)
1.13 noro 318: {
319: int i;
1.14 noro 320: TB tb;
1.13 noro 321:
1.14 noro 322: asir_assert(ARG1(arg),O_TB,"quotetotex_tb");
323: fnodetotex_tb(BDY((QUOTE)ARG0(arg)),ARG1(arg));
1.13 noro 324: *rp = 0;
325: }
326:
1.14 noro 327: void Pstring_to_tb(NODE arg,TB *rp)
328: {
329: TB tb;
330:
331: asir_assert(ARG0(arg),O_STR,"string_to_tb");
332: NEWTB(tb);
333: tb->body[0] = BDY((STRING)ARG0(arg));
334: tb->next++;
335: *rp = tb;
336: }
337:
338: void Ptb_to_string(NODE arg,STRING *rp)
339: {
340: TB tb;
341:
342: asir_assert(ARG0(arg),O_TB,"tb_to_string");
343: tb = (TB)ARG0(arg);
344: tb_to_string(tb,rp);
345: }
346:
347: void tb_to_string(TB tb,STRING *rp)
1.13 noro 348: {
1.14 noro 349: int j,len;
1.13 noro 350: char *all,*p,*q;
351:
1.14 noro 352: for ( j = 0, len = 0; j < tb->next; j++ )
353: len += strlen(tb->body[j]);
354: all = (char *)MALLOC_ATOMIC((len+1)*sizeof(char));
355: for ( j = 0, p = all; j < tb->next; j++ )
356: for ( q = tb->body[j]; *q; *p++ = *q++ );
357: *p = 0;
358: MKSTR(*rp,all);
359: }
360:
361: void Pclear_tb(NODE arg,Q *rp)
362: {
363: TB tb;
364: int j;
365:
366: asir_assert(ARG0(arg),O_TB,"clear_tb");
367: tb = (TB)ARG0(arg);
368: for ( j = 0; j < tb->next; j++ )
369: tb->body[j] = 0;
370: tb->next = 0;
371: *rp = 0;
1.13 noro 372: }
1.5 noro 373:
374: void Pstr_len(arg,rp)
375: NODE arg;
376: Q *rp;
377: {
1.16 noro 378: Obj obj;
379: TB tb;
380: int r,i;
1.5 noro 381:
1.16 noro 382: obj = (Obj)ARG0(arg);
383: if ( !obj || (OID(obj) != O_STR && OID(obj) != O_TB) )
384: error("str_len : invalid argument");
385: if ( OID(obj) == O_STR)
386: r = strlen(BDY((STRING)obj));
387: else if ( OID(obj) == O_TB ) {
388: tb = (TB)obj;
389: for ( r = i = 0; i < tb->next; i++ )
390: r += strlen(tb->body[i]);
391: }
1.5 noro 392: STOQ(r,*rp);
393: }
394:
395: void Pstr_chr(arg,rp)
396: NODE arg;
397: Q *rp;
398: {
399: STRING str,terminator;
400: Q start;
401: char *p,*ind;
402: int chr,spos,r;
403:
404: str = (STRING)ARG0(arg);
405: start = (Q)ARG1(arg);
406: terminator = (STRING)ARG2(arg);
407: asir_assert(str,O_STR,"str_chr");
408: asir_assert(start,O_N,"str_chr");
409: asir_assert(terminator,O_STR,"str_chr");
410: p = BDY(str);
411: spos = QTOS(start);
412: chr = BDY(terminator)[0];
1.8 noro 413: if ( spos > (int)strlen(p) )
1.5 noro 414: r = -1;
415: else {
416: ind = strchr(p+spos,chr);
417: if ( ind )
418: r = ind-p;
419: else
420: r = -1;
421: }
422: STOQ(r,*rp);
423: }
424:
425: void Psub_str(arg,rp)
426: NODE arg;
427: STRING *rp;
428: {
429: STRING str;
430: Q head,tail;
431: char *p,*r;
432: int spos,epos,len;
433:
434: str = (STRING)ARG0(arg);
435: head = (Q)ARG1(arg);
436: tail = (Q)ARG2(arg);
437: asir_assert(str,O_STR,"sub_str");
438: asir_assert(head,O_N,"sub_str");
439: asir_assert(tail,O_N,"sub_str");
440: p = BDY(str);
441: spos = QTOS(head);
442: epos = QTOS(tail);
443: len = strlen(p);
444: if ( (spos >= len) || (epos < spos) ) {
445: *rp = 0; return;
446: }
447: if ( epos >= len )
448: epos = len-1;
449: len = epos-spos+1;
450: r = (char *)MALLOC(len+1);
451: strncpy(r,p+spos,len);
452: r[len] = 0;
453: MKSTR(*rp,r);
454: }
1.3 noro 455:
456: void Pstrtoascii(arg,rp)
457: NODE arg;
458: LIST *rp;
459: {
460: STRING str;
461: unsigned char *p;
462: int len,i;
463: NODE n,n1;
464: Q q;
465:
466: str = (STRING)ARG0(arg);
467: asir_assert(str,O_STR,"strtoascii");
468: p = BDY(str);
469: len = strlen(p);
470: for ( i = len-1, n = 0; i >= 0; i-- ) {
471: UTOQ((unsigned int)p[i],q);
472: MKNODE(n1,q,n);
473: n = n1;
474: }
475: MKLIST(*rp,n);
476: }
477:
478: void Pasciitostr(arg,rp)
479: NODE arg;
480: STRING *rp;
481: {
482: LIST list;
483: unsigned char *p;
484: int len,i,j;
485: NODE n;
486: Q q;
487:
488: list = (LIST)ARG0(arg);
489: asir_assert(list,O_LIST,"asciitostr");
490: n = BDY(list);
491: len = length(n);
492: p = MALLOC_ATOMIC(len+1);
493: for ( i = 0; i < len; i++, n = NEXT(n) ) {
494: q = (Q)BDY(n);
495: asir_assert(q,O_N,"asciitostr");
496: j = QTOS(q);
1.4 noro 497: if ( j >= 256 || j <= 0 )
1.3 noro 498: error("asciitostr : argument out of range");
499: p[i] = j;
500: }
501: p[i] = 0;
502: MKSTR(*rp,(char *)p);
503: }
1.1 noro 504:
505: void Peval_str(arg,rp)
506: NODE arg;
507: Obj *rp;
508: {
509: FNODE fnode;
510: char *cmd;
1.10 ohara 511: #if defined(PARI)
1.8 noro 512: void recover(int);
513:
1.1 noro 514: recover(0);
1.11 saito 515: # if !(PARI_VERSION_CODE > 131588)
1.1 noro 516: if ( setjmp(environnement) ) {
517: avma = top; recover(1);
518: resetenv("");
519: }
1.11 saito 520: # endif
1.1 noro 521: #endif
522: cmd = BDY((STRING)ARG0(arg));
1.9 noro 523: exprparse_create_var(0,cmd,&fnode);
1.1 noro 524: *rp = eval(fnode);
525: }
526:
527: void Prtostr(arg,rp)
528: NODE arg;
529: STRING *rp;
530: {
531: char *b;
532: int len;
533:
1.2 noro 534: len = estimate_length(CO,ARG0(arg));
1.12 noro 535: b = (char *)MALLOC_ATOMIC(len+1);
1.1 noro 536: soutput_init(b);
537: sprintexpr(CO,ARG0(arg));
538: MKSTR(*rp,b);
539: }
540:
541: void Pstrtov(arg,rp)
542: NODE arg;
543: P *rp;
544: {
1.8 noro 545: char *p;
1.1 noro 546:
547: p = BDY((STRING)ARG0(arg));
548: #if 0
549: if ( !islower(*p) )
550: *rp = 0;
551: else {
552: for ( t = p+1; t && (isalnum(*t) || *t == '_'); t++ );
553: if ( *t )
554: *rp = 0;
555: else
556: makevar(p,rp);
557: }
558: #else
559: makevar(p,rp);
560: #endif
1.14 noro 561: }
562:
1.15 noro 563: static struct TeXSymbol texsymbol[] = {
564: {"sin","\\sin"},
565: {"cos","\\cos"},
566: {"tan","\\tan"},
567: {"sinh","\\sinh"},
568: {"cosh","\\cosh"},
569: {"tanh","\\tanh"},
570: {"exp","\\exp"},
571: {"log","\\log"},
572:
573: /* Greek Letters (lower case) */
574: {"alpha","\\alpha"},
575: {"beta","\\beta"},
576: {"gamma","\\gamma"},
577: {"delta","\\delta"},
578: {"epsilon","\\epsilon"},
579: {"varepsilon","\\varepsilon"},
580: {"zeta","\\zeta"},
581: {"eta","\\eta"},
582: {"theta","\\theta"},
583: {"vartheta","\\vartheta"},
584: {"iota","\\iota"},
585: {"kappa","\\kappa"},
586: {"lambda","\\lambda"},
587: {"mu","\\mu"},
588: {"nu","\\nu"},
589: {"xi","\\xi"},
590: {"pi","\\pi"},
591: {"varpi","\\varpi"},
592: {"rho","\\rho"},
593: {"sigma","\\sigma"},
594: {"varsigma","\\varsigma"},
595: {"tau","\\tau"},
596: {"upsilon","\\upsilon"},
597: {"phi","\\phi"},
598: {"varphi","\\varphi"},
599: {"chi","\\chi"},
600: {"omega","\\omega"},
601:
602: /* Greek Letters, (upper case) */
603: {"ggamma","\\Gamma"},
604: {"ddelta","\\Delta"},
605: {"ttheta","\\Theta"},
606: {"llambda","\\Lambda"},
607: {"xxi","\\Xi"},
608: {"ppi","\\Pi"},
609: {"ssigma","\\Sigma"},
610: {"uupsilon","\\Upsilon"},
611: {"pphi","\\Phi"},
612: {"ppsi","\\Psi"},
613: {"oomega","\\Omega"},
614:
615: /* Our own mathematical functions */
616: {"algebra_tensor","\\otimes"},
617: {"base_where","{\\rm \\ where \\ }"},
618: /* Mathematical constants */
619: {"c_pi","\\pi"},
620: {"c_i","\\sqrt{-1}"},
621:
622: /* Temporary */
623: {"dx","\\partial"},
624: {0,0}
625: };
626:
1.14 noro 627: char *symbol_name(char *name)
628: {
1.15 noro 629: int i;
630:
1.18 noro 631: if ( user_texsymbol )
632: for ( i = 0; user_texsymbol[i].text; i++ )
633: if ( !strcmp(user_texsymbol[i].text,name) )
634: return user_texsymbol[i].symbol;
1.15 noro 635: for ( i = 0; texsymbol[i].text; i++ )
636: if ( !strcmp(texsymbol[i].text,name) )
637: return texsymbol[i].symbol;
1.19 noro 638: if ( conv_rule )
639: return (*conv_rule)(name);
640: else
641: return name;
1.14 noro 642: }
643:
644: void fnodetotex_tb(FNODE f,TB tb)
645: {
646: NODE n,t,t0;
647: char vname[BUFSIZ];
648: char *opname;
649: Obj obj;
1.15 noro 650: int i,len,allzero;
1.17 noro 651: FNODE fi,f2;
1.14 noro 652:
653: write_tb(" ",tb);
654: if ( !f ) {
655: write_tb("0",tb);
656: return;
657: }
658: switch ( f->id ) {
659: /* unary operators */
660: case I_NOT: case I_PAREN: case I_MINUS:
661: switch ( f->id ) {
662: case I_NOT:
663: write_tb("\\neg (",tb);
664: fnodetotex_tb((FNODE)FA0(f),tb);
665: write_tb(")",tb);
666: break;
667: case I_PAREN:
668: write_tb("(",tb);
669: fnodetotex_tb((FNODE)FA0(f),tb);
670: write_tb(")",tb);
671: break;
672: case I_MINUS:
673: write_tb("-",tb);
674: fnodetotex_tb((FNODE)FA0(f),tb);
675: break;
676: }
677: break;
678:
679: /* binary operators */
680: case I_BOP: case I_COP: case I_LOP: case I_AND: case I_OR:
681: /* arg list */
682: /* I_AND, I_OR => FA0(f), FA1(f) */
683: /* otherwise => FA1(f), FA2(f) */
684:
685: /* op */
686: switch ( f->id ) {
687: case I_BOP:
688: opname = ((ARF)FA0(f))->name;
689: if ( !strcmp(opname,"+") ) {
690: fnodetotex_tb((FNODE)FA1(f),tb);
691: write_tb(opname,tb);
692: fnodetotex_tb((FNODE)FA2(f),tb);
693: } else if ( !strcmp(opname,"-") ) {
694: if ( FA1(f) ) fnodetotex_tb((FNODE)FA1(f),tb);
695: write_tb(opname,tb);
696: fnodetotex_tb((FNODE)FA2(f),tb);
697: } else if ( !strcmp(opname,"*") ) {
698: fnodetotex_tb((FNODE)FA1(f),tb);
699: write_tb(" ",tb);
1.17 noro 700: /* XXX special care for DP */
701: f2 = (FNODE)FA2(f);
702: if ( f2->id == I_EV ) {
703: n = (NODE)FA0(f2);
704: for ( i = 0; n; n = NEXT(n), i++ ) {
705: fi = (FNODE)BDY(n);
706: if ( fi->id != I_FORMULA || FA0(fi) )
707: break;
708: }
709: if ( n )
710: fnodetotex_tb((FNODE)FA2(f),tb);
711: } else
712: fnodetotex_tb((FNODE)FA2(f),tb);
1.14 noro 713: } else if ( !strcmp(opname,"/") ) {
714: write_tb("\\frac{",tb);
715: fnodetotex_tb((FNODE)FA1(f),tb);
716: write_tb("} {",tb);
717: fnodetotex_tb((FNODE)FA2(f),tb);
718: write_tb("}",tb);
719: } else if ( !strcmp(opname,"^") ) {
720: fnodetotex_tb((FNODE)FA1(f),tb);
721: write_tb("^{",tb);
722: fnodetotex_tb((FNODE)FA2(f),tb);
723: write_tb("} ",tb);
724: } else if ( !strcmp(opname,"%") ) {
725: fnodetotex_tb((FNODE)FA1(f),tb);
726: write_tb(" {\\rm mod}\\, ",tb);
727: fnodetotex_tb((FNODE)FA2(f),tb);
728: } else
729: error("invalid binary operator");
730:
731: case I_COP:
732: switch( (cid)FA0(f) ) {
733: case C_EQ:
734: fnodetotex_tb((FNODE)FA1(f),tb);
735: write_tb(" = ",tb);
736: fnodetotex_tb((FNODE)FA2(f),tb);
737: break;
738: case C_NE:
739: fnodetotex_tb((FNODE)FA1(f),tb);
740: write_tb(" \\neq ",tb);
741: fnodetotex_tb((FNODE)FA2(f),tb);
742: break;
743: case C_GT:
744: fnodetotex_tb((FNODE)FA1(f),tb);
745: write_tb(" \\gt ",tb);
746: fnodetotex_tb((FNODE)FA2(f),tb);
747: break;
748: case C_LT:
749: fnodetotex_tb((FNODE)FA1(f),tb);
750: write_tb(" \\lt ",tb);
751: fnodetotex_tb((FNODE)FA2(f),tb);
752: break;
753: case C_GE:
754: fnodetotex_tb((FNODE)FA1(f),tb);
755: write_tb(" \\geq ",tb);
756: fnodetotex_tb((FNODE)FA2(f),tb);
757: break;
758: case C_LE:
759: fnodetotex_tb((FNODE)FA1(f),tb);
760: write_tb(" \\leq ",tb);
761: fnodetotex_tb((FNODE)FA2(f),tb);
762: break;
763: }
764: break;
765:
766: case I_LOP:
767: switch( (lid)FA0(f) ) {
768: case L_EQ:
769: fnodetotex_tb((FNODE)FA1(f),tb);
770: write_tb(" = ",tb);
771: fnodetotex_tb((FNODE)FA2(f),tb);
772: break;
773: case L_NE:
774: fnodetotex_tb((FNODE)FA1(f),tb);
775: write_tb(" \\neq ",tb);
776: fnodetotex_tb((FNODE)FA2(f),tb);
777: break;
778: case L_GT:
779: fnodetotex_tb((FNODE)FA1(f),tb);
780: write_tb(" \\gt ",tb);
781: fnodetotex_tb((FNODE)FA2(f),tb);
782: break;
783: case L_LT:
784: fnodetotex_tb((FNODE)FA1(f),tb);
785: write_tb(" \\lt ",tb);
786: fnodetotex_tb((FNODE)FA2(f),tb);
787: break;
788: case L_GE:
789: fnodetotex_tb((FNODE)FA1(f),tb);
790: write_tb(" \\geq ",tb);
791: fnodetotex_tb((FNODE)FA2(f),tb);
792: break;
793: case L_LE:
794: fnodetotex_tb((FNODE)FA1(f),tb);
795: write_tb(" \\leq ",tb);
796: fnodetotex_tb((FNODE)FA2(f),tb);
797: break;
798: case L_AND:
799: fnodetotex_tb((FNODE)FA1(f),tb);
800: write_tb(" {\\rm \\ and\\ } ",tb);
801: fnodetotex_tb((FNODE)FA2(f),tb);
802: break;
803: case L_OR:
804: fnodetotex_tb((FNODE)FA1(f),tb);
805: write_tb(" {\\rm \\ or\\ } ",tb);
806: fnodetotex_tb((FNODE)FA2(f),tb);
807: break;
808: case L_NOT:
809: /* XXX : L_NOT is a unary operator */
810: write_tb("\\neg (",tb);
811: fnodetotex_tb((FNODE)FA1(f),tb);
812: write_tb(")",tb);
813: return;
814: }
815: break;
816:
817: case I_AND:
818: fnodetotex_tb((FNODE)FA0(f),tb);
819: write_tb(" {\\rm \\ and\\ } ",tb);
820: fnodetotex_tb((FNODE)FA1(f),tb);
821: break;
822:
823: case I_OR:
824: fnodetotex_tb((FNODE)FA0(f),tb);
825: write_tb(" {\\rm \\ or\\ } ",tb);
826: fnodetotex_tb((FNODE)FA1(f),tb);
827: break;
828: }
829: break;
830:
831: /* ternary operators */
832: case I_CE:
833: error("fnodetotex_tb : not implemented yet");
834: break;
835:
836: /* lists */
837: case I_LIST:
838: write_tb(" [ ",tb);
839: n = (NODE)FA0(f);
840: fnodenodetotex_tb(n,tb);
841: write_tb("]",tb);
842: break;
843:
844: /* function */
845: case I_FUNC: case I_CAR: case I_CDR: case I_EV:
846: switch ( f->id ) {
847: case I_FUNC:
848: opname = symbol_name(((FUNC)FA0(f))->name);
849: write_tb(opname,tb);
850: write_tb("(",tb);
851: fargstotex_tb(opname,FA1(f),tb);
852: write_tb(")",tb);
853: break;
854: case I_CAR:
855: opname = symbol_name("car");
856: write_tb(opname,tb);
857: write_tb("(",tb);
858: fargstotex_tb(opname,FA0(f),tb);
859: write_tb(")",tb);
860: break;
861: case I_CDR:
862: opname = symbol_name("cdr");
863: write_tb(opname,tb);
864: write_tb("(",tb);
865: fargstotex_tb(opname,FA0(f),tb);
866: write_tb(")",tb);
867: break;
868: case I_EV:
869: n = (NODE)FA0(f);
1.15 noro 870: allzero = 1;
1.14 noro 871: for ( t0 = 0, i = 0; n; n = NEXT(n), i++ ) {
1.15 noro 872: fi = (FNODE)BDY(n);
873: if ( fi->id == I_FORMULA && !FA0(fi) ) continue;
874: allzero = 0;
875: if ( fi->id == I_FORMULA && UNIQ(FA0(fi)) ) {
876: sprintf(vname,"x_{%d}",i);
877: len = strlen(vname);
878: opname = MALLOC_ATOMIC(len+1);
879: strcpy(opname,vname);
880: write_tb(opname,tb);
881: } else {
882: sprintf(vname,"x_{%d}^{",i);
883: len = strlen(vname);
884: opname = MALLOC_ATOMIC(len+1);
885: strcpy(opname,vname);
886: write_tb(opname,tb);
887: fnodetotex_tb((FNODE)BDY(n),tb);
888: write_tb("} ",tb);
889: }
1.14 noro 890: }
1.15 noro 891: /* XXX */
892: if ( allzero )
893: write_tb(" 1 ",tb);
1.14 noro 894: break;
895: }
896: break;
897:
898: case I_STR:
899: write_tb((char *)FA0(f),tb);
900: break;
901:
902: case I_FORMULA:
903: obj = (Obj)FA0(f);
904: if ( obj && OID(obj) == O_P ) {
905: opname = symbol_name(VR((P)obj)->name);
906: } else {
907: len = estimate_length(CO,obj);
908: opname = (char *)MALLOC_ATOMIC(len+1);
909: soutput_init(opname);
910: sprintexpr(CO,obj);
911: }
912: write_tb(opname,tb);
913: break;
914:
915: case I_PVAR:
916: if ( FA1(f) )
917: error("fnodetotex_tb : not implemented yet");
918: GETPVNAME(FA0(f),opname);
919: write_tb(opname,tb);
920: break;
921:
922: default:
923: error("fnodetotex_tb : not implemented yet");
924: }
925: }
926:
927: void fnodenodetotex_tb(NODE n,TB tb)
928: {
929: for ( ; n; n = NEXT(n) ) {
930: fnodetotex_tb((FNODE)BDY(n),tb);
931: if ( NEXT(n) ) write_tb(", ",tb);
932: }
933: }
934:
935: void fargstotex_tb(char *name,FNODE f,TB tb)
936: {
937: NODE n;
938:
939: if ( !strcmp(name,"matrix") ) {
940: error("fargstotex_tb : not implemented yet");
941: } else if ( !strcmp(name,"vector") ) {
942: error("fargstotex_tb : not implemented yet");
943: } else {
944: if ( f->id == I_LIST ) {
945: n = (NODE)FA0(f);
946: fnodenodetotex_tb(n,tb);
947: } else
948: fnodetotex_tb(f,tb);
949: }
1.1 noro 950: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>