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