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