Annotation of OpenXM_contrib2/asir2000/builtin/strobj.c, Revision 1.23
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.23 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.22 2004/03/04 13:19:11 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);
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.18 noro 297: void Pquotetotex_setenv(NODE arg,Obj *rp)
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 ) {
316: asir_assert(ARG0(arg),O_STR,"quotetotex_setenv");
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
324: error("quotetotex_setenv : invalid argument");
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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>