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