=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v retrieving revision 1.33 retrieving revision 1.39 diff -u -p -r1.33 -r1.39 --- OpenXM_contrib2/asir2000/builtin/strobj.c 2004/03/09 07:25:35 1.33 +++ OpenXM_contrib2/asir2000/builtin/strobj.c 2004/03/11 04:52:17 1.39 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.32 2004/03/09 07:18:26 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.38 2004/03/11 03:39:39 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -78,11 +78,12 @@ void Pquotetotex_env(); void fnodetotex_tb(FNODE f,TB tb); char *symbol_name(char *name); char *conv_rule(char *name); -char *conv_subscript(char *name); +char *conv_subs(char *name); char *call_convfunc(char *name); void tb_to_string(TB tb,STRING *rp); void fnodenodetotex_tb(NODE n,TB tb); void fargstotex_tb(char *opname,FNODE f,TB tb); +int top_is_minus(FNODE f); struct ftab str_tab[] = { {"rtostr",Prtostr,1}, @@ -115,6 +116,7 @@ void write_tb(char *s,TB tb) int register_symbol_table(Obj arg); int register_conv_rule(Obj arg); +int register_conv_func(Obj arg); int register_dp_vars(Obj arg); int register_dp_vars_prefix(Obj arg); int register_dp_vars_hweyl(Obj arg); @@ -129,9 +131,9 @@ static int is_lt; static int conv_flag; static int dp_vars_hweyl; -#define CONV_SUBSCRIPT (1U<<0) -#define CONV_DMODE (1U<<1) -#define CONV_USERFUNC (1U<<31) +#define CONV_TABLE (1U<<0) +#define CONV_SUBS (1U<<1) +#define CONV_DMODE (1U<<2) static struct { char *name; @@ -140,6 +142,7 @@ static struct { } qtot_env[] = { {"symbol_table",0,register_symbol_table}, {"conv_rule",0,register_conv_rule}, + {"conv_func",0,register_conv_func}, {"dp_vars",0,register_dp_vars}, {"dp_vars_prefix",0,register_dp_vars_prefix}, {"dp_vars_hweyl",0,register_dp_vars_hweyl}, @@ -153,36 +156,34 @@ char *conv_rule(char *name) { char *body,*r; + if ( convfunc ) + name = call_convfunc(name); if ( conv_flag & CONV_DMODE ) { if ( *name == 'd' ) { - if ( conv_flag & CONV_SUBSCRIPT ) - body = conv_subscript(name+1); - else - body = name+1; - r = MALLOC_ATOMIC((strlen(PARTIAL)+strlen(body)+5)*sizeof(char)); - sprintf(r,"{%s}_{%s}",PARTIAL,body); + body = conv_flag&CONV_SUBS?conv_subs(name+1):symbol_name(name+1); + if ( !body ) { + r = MALLOC_ATOMIC((strlen(PARTIAL)+1)*sizeof(char)); + strcpy(r,PARTIAL); + } else { + r = MALLOC_ATOMIC((strlen(PARTIAL)+strlen(body)+5) + *sizeof(char)); + sprintf(r,strlen(body)==1?"{%s}_%s":"{%s}_{%s}",PARTIAL,body); + } return r; - } else { - if ( conv_flag & CONV_SUBSCRIPT ) - body = conv_subscript(name); - else - body = name; - } - } else if ( conv_flag & CONV_SUBSCRIPT ) - return conv_subscript(name); - else if ( conv_flag & CONV_USERFUNC && convfunc ) - return call_convfunc(name); - else - return name; + } else + return conv_flag&CONV_SUBS?conv_subs(name):symbol_name(name); + } else + return conv_flag&CONV_SUBS?conv_subs(name):symbol_name(name); } -char *conv_subscript(char *name) +char *conv_subs(char *name) { int i,j,k,len,clen,slen,start,level; char *buf,*head,*r,*h,*brace; char **subs; len = strlen(name); + if ( !len ) return 0; subs = (char **)ALLOCA(len*sizeof(char* )); for ( i = 0, j = 0, start = i; ; j++ ) { while ( (i < len) && @@ -195,12 +196,18 @@ char *conv_subscript(char *name) else if ( name[i] == '}' ) level--; } slen = i-start; - brace = (char *)ALLOCA((slen+1)*sizeof(char)); - strncpy(brace,name+start+1,slen-2); - brace[slen-2] = 0; - buf = conv_subscript(brace); - subs[j] = (char *)ALLOCA((strlen(buf)+3)*sizeof(char)); - sprintf(subs[j],"{%s}",buf); + if ( slen >= 3 ) { + brace = (char *)ALLOCA((slen+1)*sizeof(char)); + strncpy(brace,name+start+1,slen-2); + brace[slen-2] = 0; + buf = conv_subs(brace); + subs[j] = (char *)ALLOCA((strlen(buf)+3)*sizeof(char)); + if ( strlen(buf) == 1 ) + strcpy(subs[j],buf); + else + sprintf(subs[j],"{%s}",buf); + } else + subs[j] = "{}"; } else { if ( isdigit(name[i]) ) while ( i < len && isdigit(name[i]) ) i++; @@ -218,10 +225,10 @@ char *conv_subscript(char *name) if ( j == 1 ) sprintf(h,"{%s}",subs[0]); else { - sprintf(h,"{%s}_{{%s}",subs[0],subs[1]); + sprintf(h,"{%s}_{%s",subs[0],subs[1]); h += strlen(h); for ( k = 2; k < j; k++ ) { - sprintf(h,",{%s}",subs[k]); + sprintf(h,",%s",subs[k]); h += strlen(h); } strcpy(h,"}"); @@ -310,9 +317,12 @@ int register_conv_rule(Obj arg) conv_flag = QTOS((Q)arg); convfunc = 0; return 1; - } else if ( OID(arg) == O_P && - (int)(VR((P)arg))->attr == V_SR ) { - conv_flag = CONV_USERFUNC; + } else return 0; +} + +int register_conv_func(Obj arg) +{ + if ( OID(arg) == O_P && (int)(VR((P)arg))->attr == V_SR ) { convfunc = (FUNC)(VR((P)arg)->priv); /* f must be a function which takes single argument */ return 1; @@ -384,6 +394,11 @@ void Pquotetotex_env(NODE arg,Obj *rp) NEXT(n) = 0; MKLIST(l,n0); *rp = (Obj)l; + } else if ( ac == 1 && !ARG0(arg) ) { + /* set to default */ + for ( i = 0; qtot_env[i].name; i++ ) + qtot_env[i].value = 0; + *rp = 0; } else if ( ac == 1 || ac == 2 ) { asir_assert(ARG0(arg),O_STR,"quotetotex_env"); name = BDY((STRING)ARG0(arg)); @@ -749,6 +764,9 @@ char *symbol_name(char *name) { int i; + if ( !(conv_flag & CONV_TABLE) ) + return name; + if ( user_texsymbol ) for ( i = 0; user_texsymbol[i].text; i++ ) if ( !strcmp(user_texsymbol[i].text,name) ) @@ -762,8 +780,8 @@ char *symbol_name(char *name) void fnodetotex_tb(FNODE f,TB tb) { NODE n,t,t0; - char vname[BUFSIZ]; - char *opname,*vname_conv; + char vname[BUFSIZ],prefix[BUFSIZ]; + char *opname,*vname_conv,*prefix_conv; Obj obj; int i,len,allzero,elen,elen2; FNODE fi,f2; @@ -798,7 +816,7 @@ void fnodetotex_tb(FNODE f,TB tb) opname = ((ARF)FA0(f))->name; if ( !strcmp(opname,"+") ) { fnodetotex_tb((FNODE)FA1(f),tb); - write_tb(opname,tb); + if ( !top_is_minus((FNODE)FA2(f)) ) write_tb(opname,tb); fnodetotex_tb((FNODE)FA2(f),tb); } else if ( !strcmp(opname,"-") ) { if ( FA1(f) ) fnodetotex_tb((FNODE)FA1(f),tb); @@ -991,23 +1009,26 @@ void fnodetotex_tb(FNODE f,TB tb) fi = (FNODE)BDY(n); if ( fi->id == I_FORMULA && !FA0(fi) ) continue; allzero = 0; - if ( dp_vars_hweyl ) { - if ( i < elen2 ) - if ( dp_vars_prefix ) - sprintf(vname,"%s_{%d}",dp_vars_prefix,i); + if ( dp_vars && i < dp_vars_len ) { + strcpy(vname,dp_vars[i]); + vname_conv = conv_rule(vname); + } else { + if ( dp_vars_hweyl ) { + if ( i < elen2 ) + strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x"); + else if ( i < elen ) + strcpy(prefix,"\\partial"); else - sprintf(vname,"x_{%d}",i); - else if ( i < elen ) - sprintf(vname,"{\\partial}_{%d}",i-elen2); + strcpy(prefix,"h"); + } else + strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x"); + prefix_conv = conv_rule(prefix); + vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); + if ( i < 10 ) + sprintf(vname_conv,"%s_%d",prefix_conv,i); else - strcpy(vname,"h"); - } else if ( dp_vars && i < dp_vars_len ) - strcpy(vname,dp_vars[i]); - else if ( dp_vars_prefix ) - sprintf(vname,"%s_{%d}",dp_vars_prefix,i); - else - sprintf(vname,"x_{%d}",i); - vname_conv = conv_rule(vname); + sprintf(vname_conv,"%s_{%d}",prefix_conv,i); + } if ( fi->id == I_FORMULA && UNIQ(FA0(fi)) ) { len = strlen(vname_conv); opname = MALLOC_ATOMIC(len+2); @@ -1087,5 +1108,63 @@ void fargstotex_tb(char *name,FNODE f,TB tb) fnodenodetotex_tb(n,tb); } else fnodetotex_tb(f,tb); + } +} + +int top_is_minus(FNODE f) +{ + char *opname; + int len; + Obj obj; + + if ( !f ) + return 0; + switch ( f->id ) { + case I_MINUS: + return 1; + case I_BOP: + opname = ((ARF)FA0(f))->name; + switch ( opname[0] ) { + case '+': case '*': case '/': case '^': case '%': + return top_is_minus((FNODE)FA1(f)); + case '-': + if ( FA1(f) ) + return top_is_minus((FNODE)FA1(f)); + else + return 1; + default: + return 0; + } + break; + case I_COP: + return top_is_minus((FNODE)FA1(f)); + case I_LOP: + if ( (lid)FA0(f) == L_NOT ) return 0; + else return top_is_minus((FNODE)FA1(f)); + case I_AND: case I_OR: + return top_is_minus((FNODE)FA0(f)); + case I_FORMULA: + obj = (Obj)FA0(f); + if ( !obj ) + return 0; + else { + switch ( OID(obj) ) { + case O_N: + return mmono((P)obj); + case O_P: + /* must be a variable */ + opname = conv_rule(VR((P)obj)->name); + return opname[0]=='-'; + default: + /* ??? */ + len = estimate_length(CO,obj); + opname = (char *)MALLOC_ATOMIC(len+1); + soutput_init(opname); + sprintexpr(CO,obj); + return opname[0]=='-'; + } + } + default: + return 0; } }