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