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