Annotation of OpenXM/src/asir-contrib/testing/noro/rewrite.rr, Revision 1.2
1.2 ! noro 1: /* $OpenXM: OpenXM/src/asir-contrib/testing/noro/rewrite.rr,v 1.1 2005/11/30 05:39:34 noro Exp $ */
1.1 noro 2:
3: /*
4: * test functions for rewriting by rules
5: * 2005.11.4 noro
6: *
7: * usage : rewrite(Expr,Rules,0|1|2) 0 : do not expand, 1 : expand
8: *
9: */
10:
11:
12: /* commutativity */
1.2 ! noro 13: Rc0=[`_X*_Y,`!qt_is_number(_X) && nqt_comp(_X,_Y)<0,`_Y*_X]$
1.1 noro 14: Rcomm = [Rc0]$
15:
16: /* simplifier of exp() */
17: Re1=[`exp(_X)*exp(_Y),`exp(_X+_Y)]$
18: Re2=[`exp(_X)^_K,`exp(_K*_X)]$
19: Re3=[`exp(0),`1]$
1.2 ! noro 20: Re4=[`exp(_N*p*i),`qt_is_integer(_N) && eval_quote(_N)%2==0,`1]$
1.1 noro 21: Rexp = [Re1,Re2,Re3,Re4]$
22:
23: R5=[`(_V^_N)^_M,`_V^(_N*_M)]$
24:
25: /* integration */
26: Ri1=[`int(_F+_G,_X),`int(_F,_X)+int(_G,_X)]$
1.2 ! noro 27: Ri2=[`int(_N*_F,_X),`qt_is_number(_N),`_N*int(_F,_X)]$
! 28: Ri3=[`int(_F,_X),`qt_is_number(_F), `_F*_X]$
! 29: Ri4=[`int(_X^_N,_X),`qt_is_number(_N) && eval_quote(_N)!=-1,`_X^(_N+1)/(_N+1)]$
1.1 noro 30: Ri5=[`int(_X^(-1),_X),`log(_X)]$
31: Ri6=[`int((_A*_X+_B)^(-1),_X),`1/_A*log(_A*_X+_B)]$
32: Rint = [Ri1,Ri2,Ri3,Ri4,Ri5,Ri6]$
33:
34: /* derivation */
1.2 ! noro 35: Rd0=[`d(_N*_X),`qt_is_number(_N),`_N*d(_X)]$
1.1 noro 36: Rd1=[`d(X+Y),`d(X)+d(Y)]$
37: Rd2=[`d(X*Y),`d(X)*Y+X*d(Y)]$
1.2 ! noro 38: Rd3=[`d(_N),`qt_is_number(_N),`0]$
1.1 noro 39: Rd=[Rd0,Rd1,Rd2,Rd3]$
40:
41: /* representing an expression as a polynomial w.r.t. x */
1.2 ! noro 42: /* T = qt_rewrite(qt_rewrite(Expr,[Ru0],1),[Ru1],0) */
1.1 noro 43: Ru0=[`x^_N*_X,`_X*x^_N]$
44: Ru1=[`_F*x^_N+_G*x^_N,`(_F+_G)*x^_N]$
45:
46: ctrl("print_quote",2)$
47:
48: /* unnecessary ? */
49:
50: def rec_rewrite(F,Rules,Expand)
51: {
52: while ( 1 ) {
1.2 ! noro 53: F1 = qt_rewrite(F,Rules,Expand);
1.1 noro 54: if ( F1 != F ) F = F1;
55: else return F;
56: }
57: }
58:
1.2 ! noro 59: def qt_rewrite(F,Rules,Expand)
1.1 noro 60: {
1.2 ! noro 61: F = qt_normalize(F,Expand);
1.1 noro 62: Rules = map(normalize_rule,Rules,Expand);
1.2 ! noro 63: return qt_rewrite_main(F,Rules,Expand);
1.1 noro 64: }
65:
1.2 ! noro 66: def qt_match_rewrite1(F,Pat,Cond,Action,Expand)
1.1 noro 67: {
1.2 ! noro 68: R = nqt_match(F,Pat,0);
1.1 noro 69: if ( !R ) {
1.2 ! noro 70: R = nqt_match(F,Pat,1);
1.1 noro 71: if ( !R ) {
1.2 ! noro 72: R = nqt_match(F,Pat,2);
! 73: if ( !R ) return qt_match_rewrite(`1,`0);
1.1 noro 74: }
75: }
1.2 ! noro 76: R = qt_normalize(R,Expand);
1.1 noro 77: C = eval_quote(Cond);
78: if ( C ) {
79: return eval_quote(Action,1);
80: } else {
1.2 ! noro 81: return qt_match_rewrite(`1,`0);
1.1 noro 82: }
83: }
84:
85: def normalize_rule(R,Expand)
86: {
1.2 ! noro 87: return map(qt_normalize,R,Expand);
1.1 noro 88: }
89:
90: #define O_LIST 4
91: #define O_QUOTE 17
92:
1.2 ! noro 93: def qt_rewrite_main(F,Rules,Expand)
1.1 noro 94: {
95: /* rewrite chidren */
96: F00 = F0 = F;
97: while ( 1 ) {
98: FA = quote_to_funargs(F);
99: for ( R = [FA[0]], T = cdr(FA); T != []; T = cdr(T) ) {
100: E = car(T); TE = type(E);
101: if ( TE == O_QUOTE )
1.2 ! noro 102: E1 = qt_rewrite(E,Rules,Expand);
1.1 noro 103: else if ( TE == O_LIST )
1.2 ! noro 104: E1 = map(qt_rewrite,E,Rules,Expand);
1.1 noro 105: else
106: E1 = E;
107: R = cons(E1,R);
108: }
1.2 ! noro 109: F = qt_normalize(funargs_to_quote(reverse(R)),Expand);
1.1 noro 110: if ( F == F0 ) break;
111: else F0 = F;
112: }
113: F0 = F;
114: while ( 1 ) {
115: for ( T = Rules; T != []; T = cdr(T) )
1.2 ! noro 116: F = qt_submatch_rewrite(F,car(T),Expand);
1.1 noro 117: if ( F == F0 ) break;
118: else F0 = F;
119: }
120: if ( F00 == F ) return F;
1.2 ! noro 121: else return qt_normalize(qt_rewrite(F,Rules,Expand),Expand);
1.1 noro 122: }
123:
124: #define I_NARYOP 36
125:
1.2 ! noro 126: def qt_submatch_rewrite(F,Rule,Expand)
1.1 noro 127: {
128: Pat = Rule[0];
129: if ( length(Rule) == 3 ) {
130: Cond = Rule[1]; Action = Rule[2];
131: } else {
132: Cond = `1; Action = Rule[1];
133: }
134: F0 = F;
135: while ( 1 ) {
136: Fid = get_quote_id(F);
137: if ( Fid == I_NARYOP ) {
138: FA = quote_to_funargs(F);
139: Op = get_function_name(FA[1]);
140: Arg = FA[2];
141: for ( T = Arg, H = []; T != []; H = cons(car(T),H), T = cdr(T) ) {
142: /* F0 = Pat ? */
1.2 ! noro 143: if ( Op == "*" && qt_is_number(car(T)) ) continue;
1.1 noro 144: FF = funargs_to_quote([FA[0],FA[1],T]);
1.2 ! noro 145: F1 = qt_match_rewrite1(FF,Pat,Cond,Action,Expand);
1.1 noro 146: if ( type(F1) == -1 ) {
147: /* FF = Pat op Any ? */
148: if ( Op == "+" ) {
1.2 ! noro 149: Pat1 = qt_normalize(Pat+`_Any,Expand);
! 150: F1 = qt_match_rewrite1(FF,Pat1,Cond,Action+`_Any,Expand);
! 151: F1 = qt_normalize(F1,Expand);
1.1 noro 152: } else {
1.2 ! noro 153: Pat1 = qt_normalize(Pat*`_Any,Expand);
! 154: F1 = qt_match_rewrite1(FF,Pat1,Cond,Action*`_Any,Expand);
! 155: F1 = qt_normalize(F1,Expand);
1.1 noro 156: }
157: }
158: if ( type(F1) != -1 ) {
159: if ( H == [] ) F = F1;
160: else {
161: H = reverse(cons(F1,H));
162: HF0 = funargs_to_quote([FA[0],FA[1],H]);
1.2 ! noro 163: F = qt_normalize(HF0,Expand);
1.1 noro 164: }
165: break;
166: }
167: }
168: } else {
1.2 ! noro 169: F1 = qt_match_rewrite1(F,Pat,Cond,Action,Expand);
1.1 noro 170: if ( type(F1) != -1 )
171: F = F1;
172: }
1.2 ! noro 173: F = qt_normalize(F,Expand);
1.1 noro 174: if ( F == F0 ) break;
175: else F0 = F;
176: }
177: return F;
178: }
179: end$
180:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to rewrite.rr CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / asir-contrib / testing / noro