version 1.45, 2004/03/25 01:31:03 |
version 1.52, 2005/04/05 02:29:44 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.44 2004/03/19 01:18:54 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.51 2004/08/05 00:56:54 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 65 struct TeXSymbol { |
|
Line 65 struct TeXSymbol { |
|
|
|
extern char *parse_strp; |
extern char *parse_strp; |
|
|
|
void Psprintf(); |
void Prtostr(), Pstrtov(), Peval_str(); |
void Prtostr(), Pstrtov(), Peval_str(); |
void Pstrtoascii(), Pasciitostr(); |
void Pstrtoascii(), Pasciitostr(); |
void Pstr_len(), Pstr_chr(), Psub_str(); |
void Pstr_len(), Pstr_chr(), Psub_str(); |
Line 75 void Pstring_to_tb(); |
|
Line 76 void Pstring_to_tb(); |
|
void Pquotetotex_tb(); |
void Pquotetotex_tb(); |
void Pquotetotex(); |
void Pquotetotex(); |
void Pquotetotex_env(); |
void Pquotetotex_env(); |
|
void Pflatten_quote(); |
|
void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name(); |
void fnodetotex_tb(FNODE f,TB tb); |
void fnodetotex_tb(FNODE f,TB tb); |
char *symbol_name(char *name); |
char *symbol_name(char *name); |
char *conv_rule(char *name); |
char *conv_rule(char *name); |
Line 86 void fargstotex_tb(char *opname,FNODE f,TB tb); |
|
Line 89 void fargstotex_tb(char *opname,FNODE f,TB tb); |
|
int top_is_minus(FNODE f); |
int top_is_minus(FNODE f); |
|
|
struct ftab str_tab[] = { |
struct ftab str_tab[] = { |
|
{"sprintf",Psprintf,-99999999}, |
{"rtostr",Prtostr,1}, |
{"rtostr",Prtostr,1}, |
{"strtov",Pstrtov,1}, |
{"strtov",Pstrtov,1}, |
{"eval_str",Peval_str,1}, |
{"eval_str",Peval_str,1}, |
Line 101 struct ftab str_tab[] = { |
|
Line 105 struct ftab str_tab[] = { |
|
{"quotetotex_tb",Pquotetotex_tb,2}, |
{"quotetotex_tb",Pquotetotex_tb,2}, |
{"quotetotex",Pquotetotex,1}, |
{"quotetotex",Pquotetotex,1}, |
{"quotetotex_env",Pquotetotex_env,-99999999}, |
{"quotetotex_env",Pquotetotex_env,-99999999}, |
|
{"flatten_quote",Pflatten_quote,2}, |
|
{"quote_to_funargs",Pquote_to_funargs,1}, |
|
{"funargs_to_quote",Pfunargs_to_quote,1}, |
|
{"get_function_name",Pget_function_name,1}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
Line 118 int register_symbol_table(Obj arg); |
|
Line 126 int register_symbol_table(Obj arg); |
|
int register_conv_rule(Obj arg); |
int register_conv_rule(Obj arg); |
int register_conv_func(Obj arg); |
int register_conv_func(Obj arg); |
int register_dp_vars(Obj arg); |
int register_dp_vars(Obj arg); |
|
int register_dp_vars_origin(Obj arg); |
|
int register_dp_dvars_origin(Obj arg); |
|
int register_dp_dvars_prefix(Obj arg); |
int register_dp_vars_prefix(Obj arg); |
int register_dp_vars_prefix(Obj arg); |
int register_dp_vars_hweyl(Obj arg); |
int register_dp_vars_hweyl(Obj arg); |
int register_show_lt(Obj arg); |
int register_show_lt(Obj arg); |
Line 126 static struct TeXSymbol *user_texsymbol; |
|
Line 137 static struct TeXSymbol *user_texsymbol; |
|
static char **dp_vars; |
static char **dp_vars; |
static int dp_vars_len; |
static int dp_vars_len; |
static char *dp_vars_prefix; |
static char *dp_vars_prefix; |
|
static char *dp_dvars_prefix; |
|
static int dp_vars_origin; |
|
static int dp_dvars_origin; |
static int show_lt; |
static int show_lt; |
static FUNC convfunc; |
static FUNC convfunc; |
static int is_lt; |
static int is_lt; |
|
|
{"conv_func",0,register_conv_func}, |
{"conv_func",0,register_conv_func}, |
{"dp_vars",0,register_dp_vars}, |
{"dp_vars",0,register_dp_vars}, |
{"dp_vars_prefix",0,register_dp_vars_prefix}, |
{"dp_vars_prefix",0,register_dp_vars_prefix}, |
|
{"dp_dvars_prefix",0,register_dp_dvars_prefix}, |
|
{"dp_vars_origin",0,register_dp_vars_origin}, |
|
{"dp_dvars_origin",0,register_dp_dvars_origin}, |
{"dp_vars_hweyl",0,register_dp_vars_hweyl}, |
{"dp_vars_hweyl",0,register_dp_vars_hweyl}, |
{"show_lt",0,register_show_lt}, |
{"show_lt",0,register_show_lt}, |
{0,0,0}, |
{0,0,0}, |
Line 309 int register_symbol_table(Obj arg) |
|
Line 326 int register_symbol_table(Obj arg) |
|
return 1; |
return 1; |
} |
} |
|
|
|
int register_dp_vars_origin(Obj arg) |
|
{ |
|
if ( INT(arg) ) { |
|
dp_vars_origin = QTOS((Q)arg); |
|
return 1; |
|
} else return 0; |
|
} |
|
|
|
int register_dp_dvars_origin(Obj arg) |
|
{ |
|
if ( INT(arg) ) { |
|
dp_dvars_origin = QTOS((Q)arg); |
|
return 1; |
|
} else return 0; |
|
} |
|
|
int register_dp_vars_hweyl(Obj arg) |
int register_dp_vars_hweyl(Obj arg) |
{ |
{ |
if ( INT(arg) ) { |
if ( INT(arg) ) { |
Line 393 int register_dp_vars_prefix(Obj arg) |
|
Line 426 int register_dp_vars_prefix(Obj arg) |
|
} else return 0; |
} else return 0; |
} |
} |
|
|
|
int register_dp_dvars_prefix(Obj arg) |
|
{ |
|
if ( !arg ) { |
|
dp_dvars_prefix = 0; |
|
return 1; |
|
} else if ( OID(arg) == O_STR ) { |
|
dp_dvars_prefix = BDY((STRING)arg); |
|
return 1; |
|
} else if ( OID(arg) == O_P ) { |
|
dp_dvars_prefix = NAME(VR((P)arg)); |
|
return 1; |
|
} else return 0; |
|
} |
|
|
void Pquotetotex_env(NODE arg,Obj *rp) |
void Pquotetotex_env(NODE arg,Obj *rp) |
{ |
{ |
int ac,i; |
int ac,i; |
Line 798 char *symbol_name(char *name) |
|
Line 845 char *symbol_name(char *name) |
|
return 0; |
return 0; |
} |
} |
|
|
|
void Pget_function_name(NODE arg,STRING *rp) |
|
{ |
|
QUOTEARG qa; |
|
ARF f; |
|
char *opname; |
|
|
|
qa = (QUOTEARG)BDY(arg); |
|
if ( !qa || OID(qa) != O_QUOTEARG || qa->type != A_arf ) |
|
*rp = 0; |
|
else { |
|
f = (ARF)BDY(qa); |
|
opname = f->name; |
|
MKSTR(*rp,opname); |
|
} |
|
} |
|
|
|
FNODE strip_paren(FNODE); |
|
|
void fnodetotex_tb(FNODE f,TB tb) |
void fnodetotex_tb(FNODE f,TB tb) |
{ |
{ |
NODE n,t,t0; |
NODE n,t,t0; |
char vname[BUFSIZ],prefix[BUFSIZ]; |
char vname[BUFSIZ],prefix[BUFSIZ]; |
char *opname,*vname_conv,*prefix_conv; |
char *opname,*vname_conv,*prefix_conv; |
Obj obj; |
Obj obj; |
int i,len,allzero,elen,elen2; |
int i,len,allzero,elen,elen2,si; |
C cplx; |
C cplx; |
char *r; |
char *r; |
FNODE fi,f2; |
FNODE fi,f2; |
Line 870 void fnodetotex_tb(FNODE f,TB tb) |
|
Line 935 void fnodetotex_tb(FNODE f,TB tb) |
|
} else if ( !strcmp(opname,"^") ) { |
} else if ( !strcmp(opname,"^") ) { |
fnodetotex_tb((FNODE)FA1(f),tb); |
fnodetotex_tb((FNODE)FA1(f),tb); |
write_tb("^{",tb); |
write_tb("^{",tb); |
fnodetotex_tb((FNODE)FA2(f),tb); |
fnodetotex_tb(strip_paren((FNODE)FA2(f)),tb); |
write_tb("} ",tb); |
write_tb("} ",tb); |
} else if ( !strcmp(opname,"%") ) { |
} else if ( !strcmp(opname,"%") ) { |
fnodetotex_tb((FNODE)FA1(f),tb); |
fnodetotex_tb((FNODE)FA1(f),tb); |
Line 1047 void fnodetotex_tb(FNODE f,TB tb) |
|
Line 1112 void fnodetotex_tb(FNODE f,TB tb) |
|
strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x"); |
strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x"); |
prefix_conv = conv_rule(prefix); |
prefix_conv = conv_rule(prefix); |
vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); |
vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); |
sprintf(vname_conv,i<10?"%s_%d":"%s_{%d}", |
si = i+dp_vars_origin; |
prefix_conv,i); |
sprintf(vname_conv,(si>=0&&si<10)?"%s_%d":"%s_{%d}", |
|
prefix_conv,si); |
} else if ( i < elen ) { |
} else if ( i < elen ) { |
strcpy(prefix,"\\partial"); |
strcpy(prefix, |
|
dp_dvars_prefix?dp_dvars_prefix:"\\partial"); |
prefix_conv = conv_rule(prefix); |
prefix_conv = conv_rule(prefix); |
vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); |
vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); |
sprintf(vname_conv,i<10?"%s_%d":"%s_{%d}", |
si = i+dp_dvars_origin-elen2; |
prefix_conv,i-elen2); |
sprintf(vname_conv,(si>=0&&si<10)?"%s_%d":"%s_{%d}", |
|
prefix_conv,si); |
} else { |
} else { |
strcpy(prefix,"h"); |
strcpy(prefix,"h"); |
vname_conv = conv_rule(prefix); |
vname_conv = conv_rule(prefix); |
Line 1063 void fnodetotex_tb(FNODE f,TB tb) |
|
Line 1131 void fnodetotex_tb(FNODE f,TB tb) |
|
strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x"); |
strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x"); |
prefix_conv = conv_rule(prefix); |
prefix_conv = conv_rule(prefix); |
vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); |
vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50); |
sprintf(vname_conv,i<10?"%s_%d":"%s_{%d}", |
si = i+dp_vars_origin; |
prefix_conv,i); |
sprintf(vname_conv,(si>=0&&si<10)?"%s_%d":"%s_{%d}", |
|
prefix_conv,si); |
} |
} |
} |
} |
if ( fi->id == I_FORMULA && UNIQ(FA0(fi)) ) { |
if ( fi->id == I_FORMULA && UNIQ(FA0(fi)) ) { |
Line 1152 char *objtostr(Obj obj) |
|
Line 1221 char *objtostr(Obj obj) |
|
return r; |
return r; |
} |
} |
|
|
|
void Psprintf(NODE arg,STRING *rp) |
|
{ |
|
STRING string; |
|
char *s,*t,*r; |
|
int argc,n,len; |
|
NODE node; |
|
|
|
string = (STRING)ARG0(arg); |
|
asir_assert(string,O_STR,"sprintf"); |
|
s = BDY(string); |
|
for(n = 0, t = s; *t; t++) { |
|
if (*t=='%' && *(t+1)=='a') { |
|
n++; |
|
} |
|
} |
|
for(node = NEXT(arg), argc = 0, len = strlen(s); node; node = NEXT(node), argc++) { |
|
len += estimate_length(CO,BDY(node)); |
|
} |
|
if (argc < n) { |
|
error("sprintf: invalid argument"); |
|
} |
|
r = (char *)MALLOC_ATOMIC(len); |
|
for(node = NEXT(arg), t = r; *s; s++) { |
|
if (*s=='%' && *(s+1)=='a') { |
|
strcpy(t,objtostr(BDY(node))); |
|
node = NEXT(node); |
|
t = strchr(t,0); |
|
s++; |
|
}else { |
|
*t++ = *s; |
|
} |
|
} |
|
*t = 0; |
|
MKSTR(*rp,r); |
|
} |
|
|
void fnodenodetotex_tb(NODE n,TB tb) |
void fnodenodetotex_tb(NODE n,TB tb) |
{ |
{ |
for ( ; n; n = NEXT(n) ) { |
for ( ; n; n = NEXT(n) ) { |
Line 1234 int top_is_minus(FNODE f) |
|
Line 1339 int top_is_minus(FNODE f) |
|
default: |
default: |
return 0; |
return 0; |
} |
} |
|
} |
|
|
|
FNODE flatten_fnode(FNODE,char *); |
|
|
|
void Pflatten_quote(NODE arg,Obj *rp) |
|
{ |
|
FNODE f; |
|
QUOTE q; |
|
|
|
if ( !ARG0(arg) || OID((Obj)ARG0(arg)) != O_QUOTE ) |
|
*rp = (Obj)ARG0(arg); |
|
else { |
|
f = flatten_fnode(BDY((QUOTE)ARG0(arg)),BDY((STRING)ARG1(arg))); |
|
MKQUOTE(q,f); |
|
*rp = (Obj)q; |
|
} |
|
} |
|
|
|
void Pquote_to_funargs(NODE arg,LIST *rp) |
|
{ |
|
fid_spec_p spec; |
|
QUOTE q; |
|
QUOTEARG qa; |
|
FNODE f; |
|
STRING s; |
|
QUOTE r; |
|
int i; |
|
Q id,a; |
|
LIST l; |
|
NODE t0,t,w,u,u0; |
|
|
|
q = (QUOTE)ARG0(arg); |
|
if ( !q || OID(q) != O_QUOTE ) |
|
error("quote_to_funargs : invalid argument"); |
|
f = BDY(q); |
|
if ( !f ) { |
|
MKLIST(*rp,0); |
|
return; |
|
} |
|
get_fid_spec(f->id,&spec); |
|
if ( !spec ) |
|
error("quote_to_funargs : not supported yet"); |
|
t0 = 0; |
|
STOQ((int)f->id,id); |
|
NEXTNODE(t0,t); |
|
BDY(t) = (pointer)id; |
|
for ( i = 0; spec->type[i] != A_end; i++ ) { |
|
NEXTNODE(t0,t); |
|
switch ( spec->type[i] ) { |
|
case A_fnode: |
|
MKQUOTE(r,(FNODE)f->arg[i]); |
|
BDY(t) = (pointer)r; |
|
break; |
|
case A_int: |
|
STOQ((int)f->arg[i],a); |
|
BDY(t) = (pointer)a; |
|
break; |
|
case A_str: |
|
MKSTR(s,(char *)f->arg[i]); |
|
BDY(t) = (pointer)s; |
|
break; |
|
case A_internal: |
|
BDY(t) = (pointer)f->arg[i]; |
|
break; |
|
case A_node: |
|
w = (NODE)f->arg[i]; |
|
for ( u0 = 0; w; w = NEXT(w) ){ |
|
NEXTNODE(u0,u); |
|
MKQUOTE(r,(FNODE)BDY(w)); |
|
BDY(u) = (pointer)r; |
|
} |
|
if ( u0 ) NEXT(u) = 0; |
|
MKLIST(l,u0); |
|
BDY(t) = (pointer)l; |
|
break; |
|
default: |
|
MKQUOTEARG(qa,spec->type[i],f->arg[i]); |
|
BDY(t) = (pointer)qa; |
|
break; |
|
} |
|
} |
|
if ( t0 ) NEXT(t) = 0; |
|
MKLIST(*rp,t0); |
|
} |
|
|
|
void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
{ |
|
fid_spec_p spec; |
|
QUOTE q; |
|
QUOTEARG qa; |
|
FNODE f; |
|
STRING s; |
|
QUOTE r,b; |
|
int i; |
|
LIST l; |
|
fid id; |
|
Obj a; |
|
NODE t0,t,u0,u,w; |
|
|
|
l = (LIST)ARG0(arg); |
|
if ( !l || OID(l) != O_LIST || !(t=BDY(l)) ) |
|
error("funargs_to_quote : invalid argument"); |
|
t = BDY(l); |
|
id = (fid)QTOS((Q)BDY(t)); t = NEXT(t); |
|
get_fid_spec(id,&spec); |
|
if ( !spec ) |
|
error("funargs_to_quote : not supported yet"); |
|
for ( i = 0; spec->type[i] != A_end; i++ ); |
|
NEWFNODE(f,i); |
|
f->id = id; |
|
for ( i = 0; spec->type[i] != A_end; i++, t = NEXT(t) ) { |
|
if ( !t ) |
|
error("funargs_to_quote : argument mismatch"); |
|
a = (Obj)BDY(t); |
|
switch ( spec->type[i] ) { |
|
case A_fnode: |
|
if ( !a || OID(a) != O_QUOTE ) |
|
error("funargs_to_quote : invalid argument"); |
|
f->arg[i] = BDY((QUOTE)a); |
|
break; |
|
case A_int: |
|
if ( !INT(a) ) |
|
error("funargs_to_quote : invalid argument"); |
|
f->arg[i] = (pointer)QTOS((Q)a); |
|
break; |
|
case A_str: |
|
if ( !a || OID(a) != O_STR ) |
|
error("funargs_to_quote : invalid argument"); |
|
f->arg[i] = (pointer)BDY((STRING)a); |
|
break; |
|
case A_internal: |
|
f->arg[i] = (pointer)a; |
|
break; |
|
case A_node: |
|
if ( !a || OID(a) != O_LIST ) |
|
error("funargs_to_quote : invalid argument"); |
|
u0 = 0; |
|
for ( w = BDY((LIST)a); w; w = NEXT(w) ) { |
|
NEXTNODE(u0,u); |
|
b = (QUOTE)BDY(w); |
|
if ( !b || OID(b) != O_QUOTE ) |
|
error("funargs_to_quote : invalid argument"); |
|
BDY(u) = BDY(b); |
|
} |
|
if ( u0 ) NEXT(u) = 0; |
|
f->arg[i] = (pointer)u0; |
|
break; |
|
default: |
|
if ( !a || OID(a) != O_QUOTEARG || |
|
((QUOTEARG)a)->type != spec->type[i] ) |
|
error("funargs_to_quote : invalid argument"); |
|
f->arg[i] = BDY((QUOTEARG)a); |
|
break; |
|
} |
|
} |
|
MKQUOTE(*rp,f); |
} |
} |