version 1.10, 2004/03/09 08:02:01 |
version 1.14, 2004/07/07 07:40:19 |
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.9 2004/03/04 03:31:28 noro Exp $ */ |
/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.13 2004/03/11 09:52:56 noro Exp $ */ |
|
|
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 67 void objtoquote(Obj a,QUOTE *c) |
|
Line 67 void objtoquote(Obj a,QUOTE *c) |
|
|
|
if ( !a ) { |
if ( !a ) { |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
(*c)->attr = mknode(1,mknode(2,"RisaId",0)); |
|
return; |
return; |
} |
} |
switch ( OID(a) ) { |
switch ( OID(a) ) { |
Line 79 void objtoquote(Obj a,QUOTE *c) |
|
Line 78 void objtoquote(Obj a,QUOTE *c) |
|
} else { |
} else { |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
} |
} |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_N)); |
|
break; |
break; |
case O_STR: |
case O_STR: |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_STR)); |
|
break; |
break; |
case O_P: |
case O_P: |
polytoquote((P)a,c); |
polytoquote((P)a,c); |
Line 92 void objtoquote(Obj a,QUOTE *c) |
|
Line 89 void objtoquote(Obj a,QUOTE *c) |
|
polytoquote(NM((R)a),&nm); |
polytoquote(NM((R)a),&nm); |
polytoquote(DN((R)a),&dn); |
polytoquote(DN((R)a),&dn); |
divquote(CO,nm,dn,c); |
divquote(CO,nm,dn,c); |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_R)); |
|
break; |
break; |
case O_LIST: |
case O_LIST: |
t0 = 0; |
t0 = 0; |
Line 104 void objtoquote(Obj a,QUOTE *c) |
|
Line 100 void objtoquote(Obj a,QUOTE *c) |
|
if ( t0 ) |
if ( t0 ) |
NEXT(t) = 0; |
NEXT(t) = 0; |
MKQUOTE(*c,mkfnode(1,I_LIST,t0)); |
MKQUOTE(*c,mkfnode(1,I_LIST,t0)); |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_LIST)); |
|
break; |
break; |
case O_VECT: |
case O_VECT: |
len = ((VECT)a)->len; |
len = ((VECT)a)->len; |
Line 119 void objtoquote(Obj a,QUOTE *c) |
|
Line 114 void objtoquote(Obj a,QUOTE *c) |
|
t = mknode(2,mkfnode(1,I_FORMULA,q),mkfnode(1,I_LIST,t)); |
t = mknode(2,mkfnode(1,I_FORMULA,q),mkfnode(1,I_LIST,t)); |
gen_searchf("vector",&f); |
gen_searchf("vector",&f); |
MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); |
MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_VECT)); |
|
break; |
break; |
case O_MAT: |
case O_MAT: |
row = ((MAT)a)->row; |
row = ((MAT)a)->row; |
Line 145 void objtoquote(Obj a,QUOTE *c) |
|
Line 139 void objtoquote(Obj a,QUOTE *c) |
|
mkfnode(1,I_FORMULA,qrow),mkfnode(1,I_FORMULA,qcol),fn); |
mkfnode(1,I_FORMULA,qrow),mkfnode(1,I_FORMULA,qcol),fn); |
gen_searchf("matrix",&f); |
gen_searchf("matrix",&f); |
MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); |
MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_MAT)); |
|
break; |
break; |
case O_DP: |
case O_DP: |
dptoquote((DP)a,c); |
dptoquote((DP)a,c); |
Line 167 void polytoquote(P a,QUOTE *c) |
|
Line 160 void polytoquote(P a,QUOTE *c) |
|
|
|
if ( !a ) { |
if ( !a ) { |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
(*c)->attr = mknode(1,mknode(2,"RisaId",0)); |
|
return; |
return; |
} else if ( OID(a) == O_N ) { |
} else if ( OID(a) == O_N ) { |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_N)); |
|
return; |
return; |
} |
} |
vartoquote(VR((P)a),&v); |
vartoquote(VR((P)a),&v); |
Line 190 void polytoquote(P a,QUOTE *c) |
|
Line 181 void polytoquote(P a,QUOTE *c) |
|
r = u; |
r = u; |
} |
} |
*c = r; |
*c = r; |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_P)); |
|
} |
} |
|
|
void dptoquote(DP a,QUOTE *c) |
void dptoquote(DP a,QUOTE *c) |
Line 202 void dptoquote(DP a,QUOTE *c) |
|
Line 192 void dptoquote(DP a,QUOTE *c) |
|
|
|
if ( !a ) { |
if ( !a ) { |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); |
(*c)->attr = mknode(1,mknode(2,"RisaId",0)); |
|
return; |
return; |
} |
} |
nv = NV(a); |
nv = NV(a); |
Line 221 void dptoquote(DP a,QUOTE *c) |
|
Line 210 void dptoquote(DP a,QUOTE *c) |
|
r = u; |
r = u; |
} |
} |
*c = r; |
*c = r; |
(*c)->attr = mknode(1,mknode(2,"RisaId",O_DP)); |
|
} |
} |
|
|
void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) |
void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) |
Line 251 void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) |
|
Line 239 void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) |
|
objtoquote((Obj)ONE,&r); |
objtoquote((Obj)ONE,&r); |
} else { |
} else { |
objtoquote((Obj)c,&u); |
objtoquote((Obj)c,&u); |
if ( !NUM(c) && NEXT(DC(c)) ) { |
if ( !NUM(c) && NEXT(DC(c)) && d ) { |
MKQUOTE(t,mkfnode(1,I_PAREN,BDY(u))); |
MKQUOTE(t,mkfnode(1,I_PAREN,BDY(u))); |
u = t; |
u = t; |
} |
} |
Line 310 void vartoquote(V v,QUOTE *c) |
|
Line 298 void vartoquote(V v,QUOTE *c) |
|
P x; |
P x; |
PF pf; |
PF pf; |
PFAD ad; |
PFAD ad; |
QUOTE a,b; |
QUOTE a,b,u; |
int i; |
int i; |
FUNC f; |
FUNC f; |
NODE t,t1; |
NODE t,t1; |
Line 324 void vartoquote(V v,QUOTE *c) |
|
Line 312 void vartoquote(V v,QUOTE *c) |
|
ad = ((PFINS)v->priv)->ad; |
ad = ((PFINS)v->priv)->ad; |
if ( !strcmp(NAME(pf),"pow") ) { |
if ( !strcmp(NAME(pf),"pow") ) { |
/* pow(a,b) = a^b */ |
/* pow(a,b) = a^b */ |
objtoquote(ad[0].arg,&a); objtoquote(ad[1].arg,&b); |
objtoquote(ad[0].arg,&a); |
pwrquote(CO,a,b,c); |
x = (P)ad[0].arg; |
|
/* check whether x is a variable */ |
|
if ( x && OID(x)==O_P && !NEXT(DC(x)) |
|
&& UNIQ(DEG(DC(x))) && UNIQ(COEF(DC(x))) ) { |
|
/* use a as is */ |
|
u = a; |
|
} else { |
|
/* a => (a) */ |
|
MKQUOTE(u,mkfnode(1,I_PAREN,BDY(a))); |
|
} |
|
objtoquote(ad[1].arg,&b); |
|
pwrquote(CO,u,b,c); |
} else { |
} else { |
for ( i = 0; i < pf->argc; i++ ) |
for ( i = 0; i < pf->argc; i++ ) |
if ( ad[i].d ) |
if ( ad[i].d ) |
Line 341 void vartoquote(V v,QUOTE *c) |
|
Line 340 void vartoquote(V v,QUOTE *c) |
|
} |
} |
MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); |
MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); |
} |
} |
|
} |
|
} |
|
|
|
typedef enum { |
|
A_arg,A_arf,A_int,A_str,A_internal,A_node,A_notimpl,A_func,A_end |
|
} farg_type; |
|
|
|
typedef struct fid_spec { |
|
fid id; |
|
farg_type type[10]; |
|
} *fid_spec_p; |
|
|
|
struct fid_spec fid_spec_tab[] = { |
|
{I_BOP,A_arf,A_arg,A_arg,A_end}, |
|
{I_COP,A_int,A_arg,A_arg,A_end}, |
|
{I_AND,A_arg,A_arg,A_end}, |
|
{I_OR,A_arg,A_arg,A_end}, |
|
{I_NOT,A_arg,A_end}, |
|
{I_CE,A_arg,A_arg,A_end}, |
|
{I_PRESELF,A_arf,A_arg,A_end}, |
|
{I_POSTSELF,A_arf,A_arg,A_end}, |
|
{I_FUNC,A_func,A_arg,A_end}, |
|
{I_FUNC_OPT,A_func,A_arg,A_arg,A_end}, |
|
{I_IFUNC,A_arg,A_arg,A_end}, |
|
{I_MAP,A_func,A_arg,A_end}, |
|
{I_RECMAP,A_func,A_arg,A_end}, |
|
{I_PFDERIV,A_notimpl,A_end}, |
|
{I_ANS,A_int,A_end}, |
|
{I_PVAR,A_int,A_node,A_end}, |
|
{I_ASSPVAR,A_arg,A_arg,A_end}, |
|
{I_FORMULA,A_internal,A_end}, |
|
{I_LIST,A_node,A_end}, |
|
{I_STR,A_str,A_end}, |
|
{I_NEWCOMP,A_int,A_end}, |
|
{I_CAR,A_arg,A_end}, |
|
{I_CDR,A_arg,A_end}, |
|
{I_CAST,A_notimpl,A_end}, |
|
{I_INDEX,A_arg,A_node,A_end}, |
|
{I_EV,A_node,A_end}, |
|
{I_TIMER,A_arg,A_arg,A_arg,A_end}, |
|
{I_GF2NGEN,A_end}, |
|
{I_GFPNGEN,A_end}, |
|
{I_GFSNGEN,A_end}, |
|
{I_LOP,A_int,A_arg,A_arg,A_end}, |
|
{I_OPT,A_str,A_arg,A_end}, |
|
{I_GETOPT,A_str,A_end}, |
|
{I_POINT,A_arg,A_str,A_end}, |
|
{I_PAREN,A_arg,A_end}, |
|
{I_MINUS,A_arg,A_end}, |
|
{I_NARYOP,A_notimpl,A_end} |
|
}; |
|
|
|
#define N_FID_SPEC (sizeof(fid_spec_tab)/sizeof(struct fid_spec)) |
|
|
|
void get_fid_spec(fid id,fid_spec_p *spec) |
|
{ |
|
int i; |
|
|
|
for ( i = 0; i < N_FID_SPEC; i++ ) |
|
if ( fid_spec_tab[i].id == id ) { |
|
*spec = &fid_spec_tab[i]; |
|
return; |
|
} |
|
*spec = 0; |
|
} |
|
|
|
FNODE flatten_fnode(FNODE f,char *opname) |
|
{ |
|
fid_spec_p spec; |
|
farg_type *type; |
|
fid id; |
|
FNODE f1,f2,r; |
|
int i; |
|
|
|
if ( !f ) return f; |
|
id = f->id; |
|
get_fid_spec(id,&spec); |
|
/* unknown fid */ |
|
if ( !spec ) return f; |
|
if ( id == I_BOP && !strcmp(((ARF)FA0(f))->name,opname) ) { |
|
f1 = (pointer)flatten_fnode(FA1(f),opname); |
|
f2 = (pointer)flatten_fnode(FA2(f),opname); |
|
if ( f1->id == I_BOP && !strcmp(((ARF)FA0(f1))->name,opname) ) { |
|
/* [+ [+ A B] C] => [+ A [+ B C]] */ |
|
return mkfnode(3,I_BOP,(ARF)FA0(f),FA1(f1), |
|
mkfnode(3,I_BOP,(ARF)FA0(f),FA2(f1),f2)); |
|
} else |
|
return mkfnode(3,I_BOP,(ARF)FA0(f),f1,f2); |
|
} else { |
|
type = spec->type; |
|
for ( i = 0; type[i] != A_end; i++ ); |
|
NEWFNODE(r,i); ID(r) = f->id; |
|
for ( i = 0; type[i] != A_end; i++ ) { |
|
if ( type[i] == A_arg ) |
|
r->arg[i] = (pointer)flatten_fnode(f->arg[i],opname); |
|
else |
|
r->arg[i] = f->arg[i]; |
|
} |
|
return r; |
} |
} |
} |
} |