![[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.14 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.13 2004/02/26 10:07:55 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.1 noro 61: extern char *parse_strp;
62:
63: void Prtostr(), Pstrtov(), Peval_str();
1.3 noro 64: void Pstrtoascii(), Pasciitostr();
1.5 noro 65: void Pstr_len(), Pstr_chr(), Psub_str();
1.14 ! noro 66: void Pwrite_to_tb();
! 67: void Ptb_to_string();
! 68: void Pclear_tb();
! 69: void Pstring_to_tb();
! 70: void Pquotetotex_tb();
! 71: void Pquotetotex();
! 72: void fnodetotex_tb(FNODE f,TB tb);
! 73: char *symbol_name(char *name);
! 74: void tb_to_string(TB tb,STRING *rp);
! 75: void fnodenodetotex_tb(NODE n,TB tb);
! 76: void fargstotex_tb(char *opname,FNODE f,TB tb);
1.1 noro 77:
78: struct ftab str_tab[] = {
79: {"rtostr",Prtostr,1},
80: {"strtov",Pstrtov,1},
81: {"eval_str",Peval_str,1},
1.3 noro 82: {"strtoascii",Pstrtoascii,1},
83: {"asciitostr",Pasciitostr,1},
1.5 noro 84: {"str_len",Pstr_len,1},
85: {"str_chr",Pstr_chr,3},
86: {"sub_str",Psub_str,3},
1.14 ! noro 87: {"write_to_tb",Pwrite_to_tb,2},
! 88: {"clear_tb",Pclear_tb,1},
! 89: {"tb_to_string",Ptb_to_string,1},
! 90: {"string_to_tb",Pstring_to_tb,1},
! 91: {"quotetotex_tb",Pquotetotex_tb,2},
! 92: {"quotetotex",Pquotetotex,1},
1.1 noro 93: {0,0,0},
94: };
1.13 noro 95:
1.14 ! noro 96: void write_tb(char *s,TB tb)
! 97: {
! 98: if ( tb->next == tb->size ) {
! 99: tb->size *= 2;
! 100: tb->body = (char **)REALLOC(tb->body,tb->size*sizeof(char *));
! 101: }
! 102: tb->body[tb->next] = s;
! 103: tb->next++;
! 104: }
1.13 noro 105:
1.14 ! noro 106: void Pwrite_to_tb(NODE arg,Q *rp)
1.13 noro 107: {
108: int i;
109:
1.14 ! noro 110: asir_assert(ARG1(arg),O_TB,"write_to_tb");
! 111: write_tb(BDY((STRING)ARG0(arg)),ARG1(arg));
! 112: *rp = 0;
1.13 noro 113: }
114:
1.14 ! noro 115: void Pquotetotex(NODE arg,STRING *rp)
1.13 noro 116: {
1.14 ! noro 117: TB tb;
1.13 noro 118:
1.14 ! noro 119: NEWTB(tb);
! 120: fnodetotex_tb(BDY((QUOTE)ARG0(arg)),tb);
! 121: tb_to_string(tb,rp);
1.13 noro 122: }
123:
1.14 ! noro 124: void Pquotetotex_tb(NODE arg,Q *rp)
1.13 noro 125: {
126: int i;
1.14 ! noro 127: TB tb;
1.13 noro 128:
1.14 ! noro 129: asir_assert(ARG1(arg),O_TB,"quotetotex_tb");
! 130: fnodetotex_tb(BDY((QUOTE)ARG0(arg)),ARG1(arg));
1.13 noro 131: *rp = 0;
132: }
133:
1.14 ! noro 134: void Pstring_to_tb(NODE arg,TB *rp)
! 135: {
! 136: TB tb;
! 137:
! 138: asir_assert(ARG0(arg),O_STR,"string_to_tb");
! 139: NEWTB(tb);
! 140: tb->body[0] = BDY((STRING)ARG0(arg));
! 141: tb->next++;
! 142: *rp = tb;
! 143: }
! 144:
! 145: void Ptb_to_string(NODE arg,STRING *rp)
! 146: {
! 147: TB tb;
! 148:
! 149: asir_assert(ARG0(arg),O_TB,"tb_to_string");
! 150: tb = (TB)ARG0(arg);
! 151: tb_to_string(tb,rp);
! 152: }
! 153:
! 154: void tb_to_string(TB tb,STRING *rp)
1.13 noro 155: {
1.14 ! noro 156: int j,len;
1.13 noro 157: char *all,*p,*q;
158:
1.14 ! noro 159: for ( j = 0, len = 0; j < tb->next; j++ )
! 160: len += strlen(tb->body[j]);
! 161: all = (char *)MALLOC_ATOMIC((len+1)*sizeof(char));
! 162: for ( j = 0, p = all; j < tb->next; j++ )
! 163: for ( q = tb->body[j]; *q; *p++ = *q++ );
! 164: *p = 0;
! 165: MKSTR(*rp,all);
! 166: }
! 167:
! 168: void Pclear_tb(NODE arg,Q *rp)
! 169: {
! 170: TB tb;
! 171: int j;
! 172:
! 173: asir_assert(ARG0(arg),O_TB,"clear_tb");
! 174: tb = (TB)ARG0(arg);
! 175: for ( j = 0; j < tb->next; j++ )
! 176: tb->body[j] = 0;
! 177: tb->next = 0;
! 178: *rp = 0;
1.13 noro 179: }
1.5 noro 180:
181: void Pstr_len(arg,rp)
182: NODE arg;
183: Q *rp;
184: {
185: STRING str;
186: int r;
187:
188: str = (STRING)ARG0(arg);
189: asir_assert(str,O_STR,"str_chr");
190: r = strlen(BDY(str));
191: STOQ(r,*rp);
192: }
193:
194: void Pstr_chr(arg,rp)
195: NODE arg;
196: Q *rp;
197: {
198: STRING str,terminator;
199: Q start;
200: char *p,*ind;
201: int chr,spos,r;
202:
203: str = (STRING)ARG0(arg);
204: start = (Q)ARG1(arg);
205: terminator = (STRING)ARG2(arg);
206: asir_assert(str,O_STR,"str_chr");
207: asir_assert(start,O_N,"str_chr");
208: asir_assert(terminator,O_STR,"str_chr");
209: p = BDY(str);
210: spos = QTOS(start);
211: chr = BDY(terminator)[0];
1.8 noro 212: if ( spos > (int)strlen(p) )
1.5 noro 213: r = -1;
214: else {
215: ind = strchr(p+spos,chr);
216: if ( ind )
217: r = ind-p;
218: else
219: r = -1;
220: }
221: STOQ(r,*rp);
222: }
223:
224: void Psub_str(arg,rp)
225: NODE arg;
226: STRING *rp;
227: {
228: STRING str;
229: Q head,tail;
230: char *p,*r;
231: int spos,epos,len;
232:
233: str = (STRING)ARG0(arg);
234: head = (Q)ARG1(arg);
235: tail = (Q)ARG2(arg);
236: asir_assert(str,O_STR,"sub_str");
237: asir_assert(head,O_N,"sub_str");
238: asir_assert(tail,O_N,"sub_str");
239: p = BDY(str);
240: spos = QTOS(head);
241: epos = QTOS(tail);
242: len = strlen(p);
243: if ( (spos >= len) || (epos < spos) ) {
244: *rp = 0; return;
245: }
246: if ( epos >= len )
247: epos = len-1;
248: len = epos-spos+1;
249: r = (char *)MALLOC(len+1);
250: strncpy(r,p+spos,len);
251: r[len] = 0;
252: MKSTR(*rp,r);
253: }
1.3 noro 254:
255: void Pstrtoascii(arg,rp)
256: NODE arg;
257: LIST *rp;
258: {
259: STRING str;
260: unsigned char *p;
261: int len,i;
262: NODE n,n1;
263: Q q;
264:
265: str = (STRING)ARG0(arg);
266: asir_assert(str,O_STR,"strtoascii");
267: p = BDY(str);
268: len = strlen(p);
269: for ( i = len-1, n = 0; i >= 0; i-- ) {
270: UTOQ((unsigned int)p[i],q);
271: MKNODE(n1,q,n);
272: n = n1;
273: }
274: MKLIST(*rp,n);
275: }
276:
277: void Pasciitostr(arg,rp)
278: NODE arg;
279: STRING *rp;
280: {
281: LIST list;
282: unsigned char *p;
283: int len,i,j;
284: NODE n;
285: Q q;
286:
287: list = (LIST)ARG0(arg);
288: asir_assert(list,O_LIST,"asciitostr");
289: n = BDY(list);
290: len = length(n);
291: p = MALLOC_ATOMIC(len+1);
292: for ( i = 0; i < len; i++, n = NEXT(n) ) {
293: q = (Q)BDY(n);
294: asir_assert(q,O_N,"asciitostr");
295: j = QTOS(q);
1.4 noro 296: if ( j >= 256 || j <= 0 )
1.3 noro 297: error("asciitostr : argument out of range");
298: p[i] = j;
299: }
300: p[i] = 0;
301: MKSTR(*rp,(char *)p);
302: }
1.1 noro 303:
304: void Peval_str(arg,rp)
305: NODE arg;
306: Obj *rp;
307: {
308: FNODE fnode;
309: char *cmd;
1.10 ohara 310: #if defined(PARI)
1.8 noro 311: void recover(int);
312:
1.1 noro 313: recover(0);
1.11 saito 314: # if !(PARI_VERSION_CODE > 131588)
1.1 noro 315: if ( setjmp(environnement) ) {
316: avma = top; recover(1);
317: resetenv("");
318: }
1.11 saito 319: # endif
1.1 noro 320: #endif
321: cmd = BDY((STRING)ARG0(arg));
1.9 noro 322: exprparse_create_var(0,cmd,&fnode);
1.1 noro 323: *rp = eval(fnode);
324: }
325:
326: void Prtostr(arg,rp)
327: NODE arg;
328: STRING *rp;
329: {
330: char *b;
331: int len;
332:
1.2 noro 333: len = estimate_length(CO,ARG0(arg));
1.12 noro 334: b = (char *)MALLOC_ATOMIC(len+1);
1.1 noro 335: soutput_init(b);
336: sprintexpr(CO,ARG0(arg));
337: MKSTR(*rp,b);
338: }
339:
340: void Pstrtov(arg,rp)
341: NODE arg;
342: P *rp;
343: {
1.8 noro 344: char *p;
1.1 noro 345:
346: p = BDY((STRING)ARG0(arg));
347: #if 0
348: if ( !islower(*p) )
349: *rp = 0;
350: else {
351: for ( t = p+1; t && (isalnum(*t) || *t == '_'); t++ );
352: if ( *t )
353: *rp = 0;
354: else
355: makevar(p,rp);
356: }
357: #else
358: makevar(p,rp);
359: #endif
1.14 ! noro 360: }
! 361:
! 362: char *symbol_name(char *name)
! 363: {
! 364: /* XXX */
! 365: return name;
! 366: }
! 367:
! 368: void fnodetotex_tb(FNODE f,TB tb)
! 369: {
! 370: NODE n,t,t0;
! 371: char vname[BUFSIZ];
! 372: char *opname;
! 373: Obj obj;
! 374: int i,len;
! 375:
! 376: write_tb(" ",tb);
! 377: if ( !f ) {
! 378: write_tb("0",tb);
! 379: return;
! 380: }
! 381: switch ( f->id ) {
! 382: /* unary operators */
! 383: case I_NOT: case I_PAREN: case I_MINUS:
! 384: switch ( f->id ) {
! 385: case I_NOT:
! 386: write_tb("\\neg (",tb);
! 387: fnodetotex_tb((FNODE)FA0(f),tb);
! 388: write_tb(")",tb);
! 389: break;
! 390: case I_PAREN:
! 391: write_tb("(",tb);
! 392: fnodetotex_tb((FNODE)FA0(f),tb);
! 393: write_tb(")",tb);
! 394: break;
! 395: case I_MINUS:
! 396: write_tb("-",tb);
! 397: fnodetotex_tb((FNODE)FA0(f),tb);
! 398: break;
! 399: }
! 400: break;
! 401:
! 402: /* binary operators */
! 403: case I_BOP: case I_COP: case I_LOP: case I_AND: case I_OR:
! 404: /* arg list */
! 405: /* I_AND, I_OR => FA0(f), FA1(f) */
! 406: /* otherwise => FA1(f), FA2(f) */
! 407:
! 408: /* op */
! 409: switch ( f->id ) {
! 410: case I_BOP:
! 411: opname = ((ARF)FA0(f))->name;
! 412: if ( !strcmp(opname,"+") ) {
! 413: fnodetotex_tb((FNODE)FA1(f),tb);
! 414: write_tb(opname,tb);
! 415: fnodetotex_tb((FNODE)FA2(f),tb);
! 416: } else if ( !strcmp(opname,"-") ) {
! 417: if ( FA1(f) ) fnodetotex_tb((FNODE)FA1(f),tb);
! 418: write_tb(opname,tb);
! 419: fnodetotex_tb((FNODE)FA2(f),tb);
! 420: } else if ( !strcmp(opname,"*") ) {
! 421: fnodetotex_tb((FNODE)FA1(f),tb);
! 422: write_tb(" ",tb);
! 423: fnodetotex_tb((FNODE)FA2(f),tb);
! 424: } else if ( !strcmp(opname,"/") ) {
! 425: write_tb("\\frac{",tb);
! 426: fnodetotex_tb((FNODE)FA1(f),tb);
! 427: write_tb("} {",tb);
! 428: fnodetotex_tb((FNODE)FA2(f),tb);
! 429: write_tb("}",tb);
! 430: } else if ( !strcmp(opname,"^") ) {
! 431: fnodetotex_tb((FNODE)FA1(f),tb);
! 432: write_tb("^{",tb);
! 433: fnodetotex_tb((FNODE)FA2(f),tb);
! 434: write_tb("} ",tb);
! 435: } else if ( !strcmp(opname,"%") ) {
! 436: fnodetotex_tb((FNODE)FA1(f),tb);
! 437: write_tb(" {\\rm mod}\\, ",tb);
! 438: fnodetotex_tb((FNODE)FA2(f),tb);
! 439: } else
! 440: error("invalid binary operator");
! 441:
! 442: case I_COP:
! 443: switch( (cid)FA0(f) ) {
! 444: case C_EQ:
! 445: fnodetotex_tb((FNODE)FA1(f),tb);
! 446: write_tb(" = ",tb);
! 447: fnodetotex_tb((FNODE)FA2(f),tb);
! 448: break;
! 449: case C_NE:
! 450: fnodetotex_tb((FNODE)FA1(f),tb);
! 451: write_tb(" \\neq ",tb);
! 452: fnodetotex_tb((FNODE)FA2(f),tb);
! 453: break;
! 454: case C_GT:
! 455: fnodetotex_tb((FNODE)FA1(f),tb);
! 456: write_tb(" \\gt ",tb);
! 457: fnodetotex_tb((FNODE)FA2(f),tb);
! 458: break;
! 459: case C_LT:
! 460: fnodetotex_tb((FNODE)FA1(f),tb);
! 461: write_tb(" \\lt ",tb);
! 462: fnodetotex_tb((FNODE)FA2(f),tb);
! 463: break;
! 464: case C_GE:
! 465: fnodetotex_tb((FNODE)FA1(f),tb);
! 466: write_tb(" \\geq ",tb);
! 467: fnodetotex_tb((FNODE)FA2(f),tb);
! 468: break;
! 469: case C_LE:
! 470: fnodetotex_tb((FNODE)FA1(f),tb);
! 471: write_tb(" \\leq ",tb);
! 472: fnodetotex_tb((FNODE)FA2(f),tb);
! 473: break;
! 474: }
! 475: break;
! 476:
! 477: case I_LOP:
! 478: switch( (lid)FA0(f) ) {
! 479: case L_EQ:
! 480: fnodetotex_tb((FNODE)FA1(f),tb);
! 481: write_tb(" = ",tb);
! 482: fnodetotex_tb((FNODE)FA2(f),tb);
! 483: break;
! 484: case L_NE:
! 485: fnodetotex_tb((FNODE)FA1(f),tb);
! 486: write_tb(" \\neq ",tb);
! 487: fnodetotex_tb((FNODE)FA2(f),tb);
! 488: break;
! 489: case L_GT:
! 490: fnodetotex_tb((FNODE)FA1(f),tb);
! 491: write_tb(" \\gt ",tb);
! 492: fnodetotex_tb((FNODE)FA2(f),tb);
! 493: break;
! 494: case L_LT:
! 495: fnodetotex_tb((FNODE)FA1(f),tb);
! 496: write_tb(" \\lt ",tb);
! 497: fnodetotex_tb((FNODE)FA2(f),tb);
! 498: break;
! 499: case L_GE:
! 500: fnodetotex_tb((FNODE)FA1(f),tb);
! 501: write_tb(" \\geq ",tb);
! 502: fnodetotex_tb((FNODE)FA2(f),tb);
! 503: break;
! 504: case L_LE:
! 505: fnodetotex_tb((FNODE)FA1(f),tb);
! 506: write_tb(" \\leq ",tb);
! 507: fnodetotex_tb((FNODE)FA2(f),tb);
! 508: break;
! 509: case L_AND:
! 510: fnodetotex_tb((FNODE)FA1(f),tb);
! 511: write_tb(" {\\rm \\ and\\ } ",tb);
! 512: fnodetotex_tb((FNODE)FA2(f),tb);
! 513: break;
! 514: case L_OR:
! 515: fnodetotex_tb((FNODE)FA1(f),tb);
! 516: write_tb(" {\\rm \\ or\\ } ",tb);
! 517: fnodetotex_tb((FNODE)FA2(f),tb);
! 518: break;
! 519: case L_NOT:
! 520: /* XXX : L_NOT is a unary operator */
! 521: write_tb("\\neg (",tb);
! 522: fnodetotex_tb((FNODE)FA1(f),tb);
! 523: write_tb(")",tb);
! 524: return;
! 525: }
! 526: break;
! 527:
! 528: case I_AND:
! 529: fnodetotex_tb((FNODE)FA0(f),tb);
! 530: write_tb(" {\\rm \\ and\\ } ",tb);
! 531: fnodetotex_tb((FNODE)FA1(f),tb);
! 532: break;
! 533:
! 534: case I_OR:
! 535: fnodetotex_tb((FNODE)FA0(f),tb);
! 536: write_tb(" {\\rm \\ or\\ } ",tb);
! 537: fnodetotex_tb((FNODE)FA1(f),tb);
! 538: break;
! 539: }
! 540: break;
! 541:
! 542: /* ternary operators */
! 543: case I_CE:
! 544: error("fnodetotex_tb : not implemented yet");
! 545: break;
! 546:
! 547: /* lists */
! 548: case I_LIST:
! 549: write_tb(" [ ",tb);
! 550: n = (NODE)FA0(f);
! 551: fnodenodetotex_tb(n,tb);
! 552: write_tb("]",tb);
! 553: break;
! 554:
! 555: /* function */
! 556: case I_FUNC: case I_CAR: case I_CDR: case I_EV:
! 557: switch ( f->id ) {
! 558: case I_FUNC:
! 559: opname = symbol_name(((FUNC)FA0(f))->name);
! 560: write_tb(opname,tb);
! 561: write_tb("(",tb);
! 562: fargstotex_tb(opname,FA1(f),tb);
! 563: write_tb(")",tb);
! 564: break;
! 565: case I_CAR:
! 566: opname = symbol_name("car");
! 567: write_tb(opname,tb);
! 568: write_tb("(",tb);
! 569: fargstotex_tb(opname,FA0(f),tb);
! 570: write_tb(")",tb);
! 571: break;
! 572: case I_CDR:
! 573: opname = symbol_name("cdr");
! 574: write_tb(opname,tb);
! 575: write_tb("(",tb);
! 576: fargstotex_tb(opname,FA0(f),tb);
! 577: write_tb(")",tb);
! 578: break;
! 579: case I_EV:
! 580: n = (NODE)FA0(f);
! 581: for ( t0 = 0, i = 0; n; n = NEXT(n), i++ ) {
! 582: sprintf(vname,"x_{%d}^{",i);
! 583: write_tb(vname,tb);
! 584: fnodetotex_tb((FNODE)BDY(n),tb);
! 585: write_tb("} ",tb);
! 586: }
! 587: break;
! 588: }
! 589: break;
! 590:
! 591: case I_STR:
! 592: write_tb((char *)FA0(f),tb);
! 593: break;
! 594:
! 595: case I_FORMULA:
! 596: obj = (Obj)FA0(f);
! 597: if ( obj && OID(obj) == O_P ) {
! 598: opname = symbol_name(VR((P)obj)->name);
! 599: } else {
! 600: len = estimate_length(CO,obj);
! 601: opname = (char *)MALLOC_ATOMIC(len+1);
! 602: soutput_init(opname);
! 603: sprintexpr(CO,obj);
! 604: }
! 605: write_tb(opname,tb);
! 606: break;
! 607:
! 608: case I_PVAR:
! 609: if ( FA1(f) )
! 610: error("fnodetotex_tb : not implemented yet");
! 611: GETPVNAME(FA0(f),opname);
! 612: write_tb(opname,tb);
! 613: break;
! 614:
! 615: default:
! 616: error("fnodetotex_tb : not implemented yet");
! 617: }
! 618: }
! 619:
! 620: void fnodenodetotex_tb(NODE n,TB tb)
! 621: {
! 622: for ( ; n; n = NEXT(n) ) {
! 623: fnodetotex_tb((FNODE)BDY(n),tb);
! 624: if ( NEXT(n) ) write_tb(", ",tb);
! 625: }
! 626: }
! 627:
! 628: void fargstotex_tb(char *name,FNODE f,TB tb)
! 629: {
! 630: NODE n;
! 631:
! 632: if ( !strcmp(name,"matrix") ) {
! 633: error("fargstotex_tb : not implemented yet");
! 634: } else if ( !strcmp(name,"vector") ) {
! 635: error("fargstotex_tb : not implemented yet");
! 636: } else {
! 637: if ( f->id == I_LIST ) {
! 638: n = (NODE)FA0(f);
! 639: fnodenodetotex_tb(n,tb);
! 640: } else
! 641: fnodetotex_tb(f,tb);
! 642: }
1.1 noro 643: }