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