=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/quote.c,v retrieving revision 1.7 retrieving revision 1.16 diff -u -p -r1.7 -r1.16 --- OpenXM_contrib2/asir2000/parse/quote.c 2004/03/03 09:25:30 1.7 +++ OpenXM_contrib2/asir2000/parse/quote.c 2004/07/08 03:00:30 1.16 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.6 2001/10/09 01:36:25 noro Exp $ */ +/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.15 2004/07/08 02:58:19 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -158,9 +158,12 @@ void polytoquote(P a,QUOTE *c) int n,i,sgn; QUOTE v,r,s,u; - if ( !a || (OID(a) == O_N) ) { + if ( !a ) { MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); return; + } else if ( OID(a) == O_N ) { + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); + return; } vartoquote(VR((P)a),&v); dc = DC((P)a); @@ -183,25 +186,29 @@ void polytoquote(P a,QUOTE *c) void dptoquote(DP a,QUOTE *c) { MP t; - MP *m; - int i,n,nv; + MP m; + int i,n,nv,sgn; QUOTE s,r,u; if ( !a ) { MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); return; } - for ( t = BDY(a), n = 0; t; t = NEXT(t), n++ ); - m = (MP *)ALLOCA(n*sizeof(MP)); - for ( t = BDY(a), i = 0; t; t = NEXT(t), i++ ) - m[i] = t; nv = NV(a); - mptoquote(m[n-1],nv,&r); - for ( i = n-2; i >= 0; i-- ) { - mptoquote(m[i],nv,&s); - addquote(CO,s,r,&u); + m = BDY(a); + mptoquote(m,nv,&r,&sgn); + if ( sgn == -1 ) { + MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r))); r = u; } + for ( m = NEXT(m); m; m = NEXT(m) ) { + mptoquote(m,nv,&s,&sgn); + if ( sgn < 0 ) + subquote(CO,r,s,&u); + else + addquote(CO,r,s,&u); + r = u; + } *c = r; } @@ -232,7 +239,7 @@ void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) objtoquote((Obj)ONE,&r); } else { 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))); u = t; } @@ -250,16 +257,28 @@ void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) *q = r; } -void mptoquote(MP m,int n,QUOTE *c) +void mptoquote(MP m,int n,QUOTE *r,int *sgn) { QUOTE s,u; + P c; NODE t,t1; FNODE f; Q q; DL dl; int i; - objtoquote((Obj)C(m),&s); + if ( mmono(C(m)) ) { + chsgnp(C(m),&c); + *sgn = -1; + } else { + c = C(m); + *sgn = 1; + } + objtoquote((Obj)c,&s); + if ( !NUM(c) && NEXT(DC(c)) ) { + MKQUOTE(u,mkfnode(1,I_PAREN,BDY(s))); + s = u; + } dl = m->dl; for ( i = n-1, t = 0; i >= 0; i-- ) { STOQ(dl->d[i],q); @@ -268,7 +287,10 @@ void mptoquote(MP m,int n,QUOTE *c) t = t1; } MKQUOTE(u,mkfnode(1,I_EV,t)); - mulquote(CO,s,u,c); + if ( UNIQ(c) ) + *r = u; + else + mulquote(CO,s,u,r); } void vartoquote(V v,QUOTE *c) @@ -276,7 +298,7 @@ void vartoquote(V v,QUOTE *c) P x; PF pf; PFAD ad; - QUOTE a,b; + QUOTE a,b,u; int i; FUNC f; NODE t,t1; @@ -290,8 +312,19 @@ void vartoquote(V v,QUOTE *c) ad = ((PFINS)v->priv)->ad; if ( !strcmp(NAME(pf),"pow") ) { /* pow(a,b) = a^b */ - objtoquote(ad[0].arg,&a); objtoquote(ad[1].arg,&b); - pwrquote(CO,a,b,c); + objtoquote(ad[0].arg,&a); + 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 { for ( i = 0; i < pf->argc; i++ ) if ( ad[i].d ) @@ -307,5 +340,114 @@ void vartoquote(V v,QUOTE *c) } 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 strip_paren(FNODE f) +{ + if ( !f || f->id != I_PAREN ) return f; + else { + return strip_paren((FNODE)FA0(f)); + } +} + +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); + f1 = strip_paren(f1); + f2 = (pointer)flatten_fnode(FA2(f),opname); + f2 = strip_paren(f2); + if ( f1->id == I_BOP && !strcmp(((ARF)FA0(f1))->name,opname) ) { + /* [op [op A B] C] => [op A [op 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; } }