![[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|
Return to rewrite.rr CVS log | Up to [local] / OpenXM / src / asir-contrib / testing / noro |
1.1 ! noro 1: /* $OpenXM$ */
! 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 */
! 13: Rc0=[`_X*_Y,`!quote_is_number(_X) && nquote_comp(_X,_Y)<0,`_Y*_X]$
! 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]$
! 20: Re4=[`exp(_N*p*i),`quote_is_integer(_N) && eval_quote(_N)%2==0,`1]$
! 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)]$
! 27: Ri2=[`int(_N*_F,_X),`quote_is_number(_N),`_N*int(_F,_X)]$
! 28: Ri3=[`int(_F,_X),`quote_is_number(_F), `_F*_X]$
! 29: Ri4=[`int(_X^_N,_X),`quote_is_number(_N) && eval_quote(_N)!=-1,`_X^(_N+1)/(_N+1)]$
! 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 */
! 35: Rd0=[`d(_N*_X),`quote_is_number(_N),`_N*d(_X)]$
! 36: Rd1=[`d(X+Y),`d(X)+d(Y)]$
! 37: Rd2=[`d(X*Y),`d(X)*Y+X*d(Y)]$
! 38: Rd3=[`d(_N),`quote_is_number(_N),`0]$
! 39: Rd=[Rd0,Rd1,Rd2,Rd3]$
! 40:
! 41: /* representing an expression as a polynomial w.r.t. x */
! 42: /* T = rewrite(rewrite(Expr,[Ru0],1),[Ru1],0) */
! 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 ) {
! 53: F1 = rewrite(F,Rules,Expand);
! 54: if ( F1 != F ) F = F1;
! 55: else return F;
! 56: }
! 57: }
! 58:
! 59: def rewrite(F,Rules,Expand)
! 60: {
! 61: F = quote_normalize(F,Expand);
! 62: Rules = map(normalize_rule,Rules,Expand);
! 63: return rewrite_main(F,Rules,Expand);
! 64: }
! 65:
! 66: def quote_match_rewrite1(F,Pat,Cond,Action,Expand)
! 67: {
! 68: R = nquote_match(F,Pat,0);
! 69: if ( !R ) {
! 70: R = nquote_match(F,Pat,1);
! 71: if ( !R ) {
! 72: R = nquote_match(F,Pat,2);
! 73: if ( !R ) return quote_match_rewrite(`1,`0);
! 74: }
! 75: }
! 76: R = quote_normalize(R,Expand);
! 77: C = eval_quote(Cond);
! 78: if ( C ) {
! 79: return eval_quote(Action,1);
! 80: } else {
! 81: return quote_match_rewrite(`1,`0);
! 82: }
! 83: }
! 84:
! 85: def normalize_rule(R,Expand)
! 86: {
! 87: return map(quote_normalize,R,Expand);
! 88: }
! 89:
! 90: #define O_LIST 4
! 91: #define O_QUOTE 17
! 92:
! 93: def rewrite_main(F,Rules,Expand)
! 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 )
! 102: E1 = rewrite(E,Rules,Expand);
! 103: else if ( TE == O_LIST )
! 104: E1 = map(rewrite,E,Rules,Expand);
! 105: else
! 106: E1 = E;
! 107: R = cons(E1,R);
! 108: }
! 109: F = quote_normalize(funargs_to_quote(reverse(R)),Expand);
! 110: if ( F == F0 ) break;
! 111: else F0 = F;
! 112: }
! 113: F0 = F;
! 114: while ( 1 ) {
! 115: for ( T = Rules; T != []; T = cdr(T) )
! 116: F = quote_submatch_rewrite(F,car(T),Expand);
! 117: if ( F == F0 ) break;
! 118: else F0 = F;
! 119: }
! 120: if ( F00 == F ) return F;
! 121: else return quote_normalize(rewrite(F,Rules,Expand),Expand);
! 122: }
! 123:
! 124: #define I_NARYOP 36
! 125:
! 126: def quote_submatch_rewrite(F,Rule,Expand)
! 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 ? */
! 143: if ( Op == "*" && quote_is_number(car(T)) ) continue;
! 144: FF = funargs_to_quote([FA[0],FA[1],T]);
! 145: F1 = quote_match_rewrite1(FF,Pat,Cond,Action,Expand);
! 146: if ( type(F1) == -1 ) {
! 147: /* FF = Pat op Any ? */
! 148: if ( Op == "+" ) {
! 149: Pat1 = quote_normalize(Pat+`_Any,Expand);
! 150: F1 = quote_match_rewrite1(FF,Pat1,Cond,Action+`_Any,Expand);
! 151: F1 = quote_normalize(F1,Expand);
! 152: } else {
! 153: Pat1 = quote_normalize(Pat*`_Any,Expand);
! 154: F1 = quote_match_rewrite1(FF,Pat1,Cond,Action*`_Any,Expand);
! 155: F1 = quote_normalize(F1,Expand);
! 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]);
! 163: F = quote_normalize(HF0,Expand);
! 164: }
! 165: break;
! 166: }
! 167: }
! 168: } else {
! 169: F1 = quote_match_rewrite1(F,Pat,Cond,Action,Expand);
! 170: if ( type(F1) != -1 )
! 171: F = F1;
! 172: }
! 173: F = quote_normalize(F,Expand);
! 174: if ( F == F0 ) break;
! 175: else F0 = F;
! 176: }
! 177: return F;
! 178: }
! 179: end$
! 180: