Annotation of OpenXM/src/asir-contrib/testing/noro/new_rewrite.rr, Revision 1.1
1.1 ! noro 1: $OpenXM$
! 2:
! 3: /*
! 4: * test functions for rewriting by rules
! 5: *
! 6: * usage : qt_rewrite(Expr,Rules,0|1|2) 0 : do not expand, 1 : expand
! 7: *
! 8: */
! 9:
! 10: /* commutativity */
! 11: #if 0
! 12: Rc0=[`_X*_Y,`!qt_is_number(_X) && nqt_comp(_X,_Y)<0,`_Y*_X]$
! 13: #else
! 14: Rc0=[`_X*_Y,`nqt_comp(_Y*_X,_X*_Y)>0,`_Y*_X]$
! 15: #endif
! 16: Rcomm = [Rc0]$
! 17:
! 18: /* alternativity */
! 19: Ra0=[`X*Y,`qt_is_var(X) && qt_is_var(Y) && nqt_comp(Y,X)>0,`-Y*X]$
! 20: Ra1=[`X^N,`eval_quote(N)>=2,`0]$
! 21: Ra2=[`X*X,`0]$
! 22: Ralt = [Ra0,Ra1,Ra2]$
! 23:
! 24: /* simplifier of exp() */
! 25: Re1=[`exp(_X)*exp(_Y),`exp(_X+_Y)]$
! 26: Re2=[`exp(_X)^_K,`exp(_K*_X)]$
! 27: Re3=[`exp(0),`1]$
! 28: Re4=[`exp(_N*p*i),`qt_is_integer(_N) && eval_quote(_N)%2==0,`1]$
! 29: Rexp = [Re1,Re2,Re3,Re4]$
! 30:
! 31: R5=[`(_V^_N)^_M,`_V^(_N*_M)]$
! 32:
! 33: /* integration */
! 34: Ri1=[`int(_F+_G,_X),`int(_F,_X)+int(_G,_X)]$
! 35: Ri2=[`int(_N*_F,_X),`qt_is_number(_N),`_N*int(_F,_X)]$
! 36: Ri3=[`int(_F,_X),`qt_is_number(_F), `_F*_X]$
! 37: Ri4=[`int(_X^_N,_X),`qt_is_number(_N) && eval_quote(_N)!=-1,`_X^(_N+1)/(_N+1)]$
! 38: Ri5=[`int(_X^(-1),_X),`log(_X)]$
! 39: Ri6=[`int((_A*_X+_B)^(-1),_X),`1/_A*log(_A*_X+_B)]$
! 40: Rint = [Ri1,Ri2,Ri3,Ri4,Ri5,Ri6]$
! 41:
! 42: /* derivation */
! 43: Rd0=[`d(_N*_X),`qt_is_number(_N),`_N*d(_X)]$
! 44: Rd1=[`d(X+Y),`d(X)+d(Y)]$
! 45: Rd2=[`d(X*Y),`d(X)*Y+X*d(Y)]$
! 46: Rd3=[`d(_N),`qt_is_number(_N),`0]$
! 47: Rd=[Rd0,Rd1,Rd2,Rd3]$
! 48:
! 49: /* representing an expression as a polynomial w.r.t. x */
! 50: /* T = qt_rewrite(qt_rewrite(Expr,[Ru0],1),[Ru1],0) */
! 51: Ru0=[`x^_N*_X,`_X*x^_N]$
! 52: Ru1=[`_F*x^_N+_G*x^_N,`(_F+_G)*x^_N]$
! 53: #define O_LIST 4
! 54: #define O_QUOTE 17
! 55:
! 56: ctrl("print_quote",2)$
! 57:
! 58: def normalize_rule(R,Expand)
! 59: {
! 60: return map(qt_normalize,R,Expand);
! 61: }
! 62:
! 63: def qt_rewrite(F,Rules,Expand)
! 64: {
! 65: F = qt_normalize(F,Expand);
! 66: Rules = map(normalize_rule,Rules,Expand);
! 67:
! 68: /* rewrite chidren */
! 69: F00 = F0 = F;
! 70: while ( 1 ) {
! 71: FA = quote_to_funargs(F);
! 72: for ( R = [FA[0]], T = cdr(FA); T != []; T = cdr(T) ) {
! 73: E = car(T); TE = type(E);
! 74: if ( TE == O_QUOTE )
! 75: E1 = qt_rewrite(E,Rules,Expand);
! 76: else if ( TE == O_LIST )
! 77: E1 = map(qt_rewrite,E,Rules,Expand);
! 78: else
! 79: E1 = E;
! 80: R = cons(E1,R);
! 81: }
! 82: F = qt_normalize(funargs_to_quote(reverse(R)),Expand);
! 83: if ( F == F0 ) break;
! 84: else F0 = F;
! 85: }
! 86: F0 = F;
! 87: while ( 1 ) {
! 88: for ( T = Rules; T != []; T = cdr(T) ) {
! 89: F1 = nqt_match_rewrite(F,car(T),Expand);
! 90: if ( F1 != F ) {
! 91: F = F1; break;
! 92: }
! 93: }
! 94: if ( F == F0 ) break;
! 95: else F0 = F;
! 96: }
! 97: if ( F00 == F ) return F;
! 98: else return qt_normalize(qt_rewrite(F,Rules,Expand),Expand);
! 99: }
! 100: end$
! 101:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>