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