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