=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/quote.c,v retrieving revision 1.9 retrieving revision 1.17 diff -u -p -r1.9 -r1.17 --- OpenXM_contrib2/asir2000/parse/quote.c 2004/03/04 03:31:28 1.9 +++ OpenXM_contrib2/asir2000/parse/quote.c 2004/07/13 07:59:54 1.17 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.8 2004/03/04 01:41:32 noro Exp $ */ +/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.16 2004/07/08 03:00:30 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -49,7 +49,7 @@ void chsgnquote(QUOTE a,QUOTE *c) { FNODE fn; - fn = mkfnode(3,I_BOP,subfs,0,BDY(a)); + fn = mkfnode(1,I_MINUS,BDY(a)); MKQUOTE(*c,fn); } @@ -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); @@ -236,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; } @@ -295,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; @@ -309,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 ) @@ -326,5 +340,105 @@ void vartoquote(V v,QUOTE *c) } MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); } + } +} + +struct fid_spec fid_spec_tab[] = { + {I_BOP,A_arf,A_fnode,A_fnode,A_end}, + {I_COP,A_int,A_fnode,A_fnode,A_end}, + {I_AND,A_fnode,A_fnode,A_end}, + {I_OR,A_fnode,A_fnode,A_end}, + {I_NOT,A_fnode,A_end}, + {I_CE,A_fnode,A_fnode,A_end}, + {I_PRESELF,A_arf,A_fnode,A_end}, + {I_POSTSELF,A_arf,A_fnode,A_end}, + {I_FUNC,A_func,A_fnode,A_end}, + {I_FUNC_OPT,A_func,A_fnode,A_fnode,A_end}, + {I_IFUNC,A_fnode,A_fnode,A_end}, + {I_MAP,A_func,A_fnode,A_end}, + {I_RECMAP,A_func,A_fnode,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_fnode,A_fnode,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_fnode,A_end}, + {I_CDR,A_fnode,A_end}, + {I_CAST,A_notimpl,A_end}, + {I_INDEX,A_fnode,A_node,A_end}, + {I_EV,A_node,A_end}, + {I_TIMER,A_fnode,A_fnode,A_fnode,A_end}, + {I_GF2NGEN,A_end}, + {I_GFPNGEN,A_end}, + {I_GFSNGEN,A_end}, + {I_LOP,A_int,A_fnode,A_fnode,A_end}, + {I_OPT,A_str,A_fnode,A_end}, + {I_GETOPT,A_str,A_end}, + {I_POINT,A_fnode,A_str,A_end}, + {I_PAREN,A_fnode,A_end}, + {I_MINUS,A_fnode,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_fnode ) + r->arg[i] = (pointer)flatten_fnode(f->arg[i],opname); + else + r->arg[i] = f->arg[i]; + } + return r; } }