Annotation of OpenXM/src/asir-contrib/testing/tr.rr, Revision 1.2
1.2 ! takayama 1: /* $OpenXM$ */
! 2: /* $Id: tr.rr,v 1.2 2005/04/02 05:55:37 taka Exp $ */
! 3:
! 4: /*
! 5: OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B.
! 6: */
! 7: /* $Id: tr.rr,v 1.2 2005/04/02 05:55:37 taka Exp $
! 8: $B$3$N%U%!%$%k$O(B quotetolist $B$G%j%9%H$KJQ49$7$?%G!<%?$KBP$7$F(B
! 9: $B%Q%?!<%s%^%C%A$*$h$S$=$l$r1~MQ$7$?JQ7A$r9T$&(B.
! 10: tr.oxt $B$N;EMM$H$3$H$J$j(B quotetolist $B$GJQ49$7$?$b$N$r07$&(B.
! 11: $B%F%9%H%W%m%0%i%`$N$?$a8zN($OL5;k(B. (append $B$NB?MQ(B, $BL5BL$J(B2$B=E8F$S=P$7(B, $B$J$I(B))
! 12: */
! 13:
! 14: extern Debug$
! 15: Debug=0$
! 16: def dprint(X) {
! 17: if (Debug) print(X);
! 18: }
! 19: def dprint0(X) {
! 20: if (Debug) print(X,0);
! 21: }
! 22:
! 23:
! 24: def qt_node(F) {
! 25: return [F[0],F[1]];
! 26: }
! 27: /* Number of child */
! 28: def qt_nchild(F) {
! 29: return length(F)-2;
! 30: }
! 31: def qt_child(F,K) {
! 32: return F[K+2];
! 33: }
! 34:
! 35: /*
! 36: $B%j%9%H(B F $B$,(B $B%j%9%H(B P $B$K(B($B@hF,$+$i$NHf3S$G(B)$B%^%C%A$7$?$i(B 1.
! 37: $B$=$&$G$J$$$+$i(B 0. $BI}M%@hC5:w(B.
! 38: Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.
! 39: */
! 40: def tr_match0(F,P) {
! 41: dprint0("tr_match0: F="); dprint(F);
! 42: dprint0("tr_match0: P="); dprint(P);
! 43:
! 44: if (type(F) != type(P)) return 0;
! 45: if (type(F) != 4) {
! 46: if (F == P) return 1;
! 47: else return 0;
! 48: }
! 49: Node = qt_node(F);
! 50: Node2 = qt_node(P);
! 51: if (Node2 == ["function","pn"]) return 2;
! 52: if (Node != Node2) return 0;
! 53: N = qt_nchild(F);
! 54: if (N != qt_nchild(P)) return 0;
! 55: for (I=0; I<N; I++) {
! 56: C = qt_child(F,I);
! 57: C2 = qt_child(P,I);
! 58: if (!tr_match0(C,C2)) return 0;
! 59: }
! 60: return 1;
! 61: }
! 62:
! 63: /* F $B$H(B P $B$,(B tr_match0 $B$9$k$H$-(B bindingTable $B$r$b$I$9(B.
! 64: [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]
! 65: */
! 66: def tr_make_binding(F,P) {
! 67: Ans = [ ];
! 68: if (F == P) return Ans;
! 69:
! 70: Node = qt_node(F);
! 71: Node2 = qt_node(P);
! 72:
! 73: if (Node2 == ["function", "pn"]) {
! 74: Ans = append(Ans,[[P[2][1],F]]);
! 75: return Ans;
! 76: }
! 77: N = qt_nchild(F);
! 78: for (I=0; I<N; I++) {
! 79: C = qt_child(F,I);
! 80: C2 = qt_child(P,I);
! 81: Ans = append(Ans,tr_make_binding(C,C2));
! 82: }
! 83: return Ans;
! 84: }
! 85:
! 86: /*
! 87: Tree $B$NCf$rI}M%@hC5:w$G8!:w$7$F(B $BCV$-49$($k(B.
! 88: $BI}M%@hC5:w$J$N$G(B, $BF1$8(B rule $B$K%^%C%A$9$k$b$N$,F~$l;R$K$J$C$?>l9g(B,
! 89: $BFbB&$OCV$-49$($i$l$J$$(B.
! 90: $B?<$5M%@hC5:w$K$7$?(B --> action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B.
! 91: Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.
! 92: */
! 93: def tr_rp(F,P,Q) {
! 94: dprint0("tr_rp, F="); dprint(F);
! 95: dprint0("tr_rp, P="); dprint(P);
! 96: dprint0("tr_rp, Q="); dprint(Q);
! 97: if (tr_match0(F,P)) {
! 98: BindTable = tr_make_binding(F,P);
! 99: dprint0("BindTable="); dprint(BindTable);
! 100: return tr_apply_function0(Q,BindTable);
! 101: }
! 102: if (type(F) != 4) return F;
! 103: Node = qt_node(F);
! 104: N = qt_nchild(F);
! 105: Ans = Node;
! 106: for (I=0; I<N; I++) {
! 107: T = tr_rp(qt_child(F,I),P,Q);
! 108: Ans = append(Ans,[T]);
! 109: }
! 110: return Ans;
! 111: }
! 112:
! 113: /* ["f","x"],[["x",[internal,3]]] $B$N;~$O(B
! 114: f(3) $B$r7W;;$9$k(B.
! 115: */
! 116: def tr_apply_function0(Q,BindTable) {
! 117: B = [ ];
! 118: N = length(BindTable);
! 119: /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */
! 120: for (I=0; I<N; I++) {
! 121: B = append(B,[[BindTable[I][0],"quote("+quote_input_form_quote_list(BindTable[I][1])+")"]]);
! 122: }
! 123: dprint0("tr_apply_function0: "); dprint(B);
! 124: N = length(Q)-1; /* $B0z?t$N?t(B */
! 125: M = length(B); /* binding table $B$N%5%$%:(B */
! 126: R = Q[0]+"(";
! 127: for (I=0; I<N; I++) {
! 128: X = rtostr(Q[I+1]); /* $BJQ?t(B */
! 129: /* binding Table $B$r%5!<%A(B */
! 130: for (J=0; J<M; J++) {
! 131: Y = rtostr(B[J][0]);
! 132: if (X == Y) {
! 133: R = R+B[J][1];
! 134: if (I != N-1) R = R+",";
! 135: break;
! 136: }
! 137: if (J == M-1) error("No binding data.");
! 138: }
! 139: }
! 140: R = R+")";
! 141: dprint0("R="); dprint(R);
! 142: return eval_str(R);
! 143: }
! 144:
! 145:
! 146: /* L $B$,:85,B'(B. R $B$,1&5,B'(B. $BI}M%@hC5:w(B.
! 147: $B=q$-49$($r$9$k$?$a$N%H%C%W%l%Y%k$N4X?t(B ($B$N$R$H$D(B).
! 148: $BNc(B:
! 149: tr_apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),
! 150: quote(sin(pn("x")*@pi)),
! 151: ["qt_sin_int","x"]);
! 152: */
! 153: def tr_apply_rule1(Obj,L,R) {
! 154: dprint("-------- start of tr_apply_rule1 ------------ ");
! 155: Obj = quotetolist(Obj);
! 156: L = quotetolist(L);
! 157: R = tr_rp(Obj,L,R);
! 158: RR = "quote("+quote_input_form_quote_list(R)+")";
! 159: dprint("-------- end of tr_apply_rule1 ------------ ");
! 160: return eval_str(RR);
! 161: }
! 162:
! 163: /* quote $B$KBP$9$k(B $B=R8l(B */
! 164: def qt_is_integer(Qlist) {
! 165: if (Qlist[0] == "internal") {
! 166: Z = eval_str(rtostr(Qlist[1]));
! 167: }else{
! 168: return 0;
! 169: }
! 170: if (type(Z) == 0) return 1;
! 171: if ((type(Z) == 1) && (ntype(Z) == 0)) return 1;
! 172: return 0;
! 173: }
! 174:
! 175: /* quote $B$N@8@.(B */
! 176: /* $B1&5,B'4X?t(B. 0 $B$rLa$9(B. */
! 177: def qt_zero() {
! 178: return quotetolist(quote(0));
! 179: }
! 180:
! 181: /* $B1&5,B'4X?t(B. $B91Ey<0(B */
! 182: def qt_id(X) {
! 183: return quotetolist(X);
! 184: }
! 185:
! 186: /* ------------ test --------------------------- */
! 187: extern Rule_test2$
! 188: Rule_test2=[quote(sin(pn("x")*@pi)),["qt_sin_int2","x"]]$
! 189:
! 190: def test2() {
! 191: /* $BI}M%@hC5:w$N>l9g(B, R0 $B$O(B simplify $B$G$-$:(B. */
! 192: Rule1=[quote(sin(pn("x")*@pi)),["qt_sin_int","x"]];
! 193: R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
! 194: print(print_input_form(R0));
! 195: R=tr_apply_rule1(R0,Rule1[0],Rule1[1]);
! 196: print(print_input_form(R));
! 197: print("-----------------------");
! 198: /* $B<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */
! 199: R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
! 200: print(print_input_form(R0));
! 201: R=tr_apply_rule1(R0,Rule_test2[0],Rule_test2[1]);
! 202: print(print_input_form(R));
! 203: }
! 204:
! 205: /* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */
! 206: def qt_sin_int(X) {
! 207: /* $B$$$^(B X $B$O(B quote $B7?(B */
! 208: Y = quotetolist(X);
! 209: /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */
! 210: R = "quote(sin("+quote_input_form_quote_list(Y)+"*@pi))";
! 211: print(R);
! 212: R = eval_str(R);
! 213: /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.
! 214: */
! 215: if (Y[0] == "internal") {
! 216: Z = eval_str(rtostr(Y[1]));
! 217: }else{
! 218: return quotetolist(R);
! 219: }
! 220: if (type(Z) == 0) return quotetolist(quote(0));
! 221: if ((type(Z) == 1) && (ntype(Z) == 0)) return quotetolist(quote(0));
! 222: return quotetolist(R);
! 223: }
! 224:
! 225: /* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */
! 226: def qt_sin_int2(X) {
! 227: /* tr_apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */
! 228: X = tr_apply_rule1(X,Rule_test2[0],Rule_test2[1]);
! 229: Y = quotetolist(X);
! 230: R = "quote(sin("+quote_input_form_quote_list(Y)+"*@pi))";
! 231: print(R);
! 232: R = eval_str(R);
! 233: if (qt_is_integer(Y)) return quotetolist(quote(0));
! 234: else return quotetolist(R);
! 235: }
! 236:
! 237:
! 238: /* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r(B
! 239: */
! 240:
! 241: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to tr.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