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