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