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