[BACK]Return to tr.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / testing

Annotation of OpenXM/src/asir-contrib/testing/tr.rr, Revision 1.5

1.5     ! takayama    1: /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.4 2005/04/06 09:26:28 takayama Exp $ */
        !             2: /* $Id: tr.rr,v 1.10 2005/04/07 12:34:51 taka Exp $ */
1.2       takayama    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: */
1.5     ! takayama    7: /* $Id: tr.rr,v 1.10 2005/04/07 12:34:51 taka Exp $
1.2       takayama    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:
1.3       takayama   23: /* quotetolist $B$N5U4X?t(B. $B$?$@$7J8;zNs$G(B */
                     24: def listtoquote_str(L) {
                     25:   return quote_input_form_quote_list(L);
                     26: }
1.2       takayama   27:
                     28: def qt_node(F) {
1.3       takayama   29:    if (type(F) == 17) F=quotetolist(F);
                     30:    return [rtostr(F[0]),rtostr(F[1])];
1.2       takayama   31: }
                     32: /* Number of  child */
                     33: def qt_nchild(F) {
1.3       takayama   34:    if (type(F) == 17) F=quotetolist(F);
1.2       takayama   35:    return length(F)-2;
                     36: }
                     37: def qt_child(F,K) {
1.3       takayama   38:    if (type(F) == 17) F=quotetolist(F);
1.2       takayama   39:    return F[K+2];
                     40: }
                     41:
                     42: /*
                     43:    $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.
                     44:    $B$=$&$G$J$$$+$i(B 0.  $BI}M%@hC5:w(B.
                     45:     Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.
                     46: */
                     47: def tr_match0(F,P)  {
                     48:   dprint0("tr_match0: F="); dprint(F);
                     49:   dprint0("tr_match0: P="); dprint(P);
                     50:
                     51:   if (type(F) != type(P)) return 0;
                     52:   if (type(F) != 4) {
                     53:     if (F == P) return 1;
                     54:     else return 0;
                     55:   }
                     56:   Node = qt_node(F);
                     57:   Node2 = qt_node(P);
1.3       takayama   58:   /* pn $B$K2?$N@)Ls$b$J$1$l$P(B 2 $B$rLa$9(B. */
                     59:   if (Node2 == ["function","pn"]) return tr_check_pn(F,P);
1.2       takayama   60:   if (Node != Node2) return 0;
                     61:   N = qt_nchild(F);
                     62:   if (N != qt_nchild(P)) return 0;
                     63:   for (I=0; I<N; I++) {
                     64:      C = qt_child(F,I);
                     65:      C2 = qt_child(P,I);
                     66:      if (!tr_match0(C,C2)) return 0;
                     67:   }
                     68:   return 1;
                     69: }
                     70:
1.3       takayama   71: /*
                     72:    P $B$NNc(B: P = pn("x");  P=pn("x",qt_is_integer(x));
                     73:    P $B$O(B [function,pn,[internal,x],[function,is_int,[internal,x]]]
                     74:    FF $B$O(B ["is_int","x"]
                     75:    $B%F%9%H%G!<%?(B.
                     76:  tr_check_pn(quote(1/2),quote(pn("x",qt_is_integer(x))));
                     77: */
                     78: def tr_check_pn(F,P) {
                     79:   if (type(F) ==17) F=quotetolist(F);
                     80:   if (type(P) == 17) P=quotetolist(P);
                     81:   N=qt_nchild(P);
                     82:   if (N == 1) return 2;
                     83:   X = rtostr(qt_child(P,0)[1]);
                     84:   BindingTable = [[X,F]];
                     85:   FF = [rtostr(qt_child(P,1)[1]),rtostr(qt_child(P,1)[2][1])];
                     86:   R = tr_apply_function0(FF,BindingTable);
                     87:   return R;
                     88: }
                     89:
1.2       takayama   90: /* F $B$H(B P $B$,(B tr_match0 $B$9$k$H$-(B  bindingTable $B$r$b$I$9(B.
                     91:   [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]
                     92: */
                     93: def tr_make_binding(F,P) {
                     94:   Ans = [ ];
                     95:   if (F == P) return Ans;
                     96:
                     97:   Node = qt_node(F);
                     98:   Node2 = qt_node(P);
                     99:
                    100:   if (Node2 == ["function", "pn"]) {
1.3       takayama  101:      Ans = append(Ans,[[rtostr(P[2][1]),F]]);
1.2       takayama  102:      return Ans;
                    103:   }
                    104:   N = qt_nchild(F);
                    105:   for (I=0; I<N; I++) {
                    106:      C = qt_child(F,I);
                    107:      C2 = qt_child(P,I);
                    108:      Ans = append(Ans,tr_make_binding(C,C2));
                    109:   }
                    110:   return Ans;
                    111: }
                    112:
                    113: /*
                    114:    Tree $B$NCf$rI}M%@hC5:w$G8!:w$7$F(B $BCV$-49$($k(B.
                    115:    $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,
                    116:    $BFbB&$OCV$-49$($i$l$J$$(B.
                    117:    $B?<$5M%@hC5:w$K$7$?(B --> action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B.
                    118:    Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.
                    119: */
                    120: def tr_rp(F,P,Q) {
                    121:   dprint0("tr_rp, F="); dprint(F);
                    122:   dprint0("tr_rp, P="); dprint(P);
                    123:   dprint0("tr_rp, Q="); dprint(Q);
                    124:   if (tr_match0(F,P)) {
                    125:      BindTable = tr_make_binding(F,P);
                    126:      dprint0("BindTable="); dprint(BindTable);
                    127:      return tr_apply_function0(Q,BindTable);
                    128:   }
                    129:   if (type(F) != 4) return F;
                    130:   Node = qt_node(F);
                    131:   N = qt_nchild(F);
                    132:   Ans = Node;
                    133:   for (I=0; I<N; I++) {
                    134:     T = tr_rp(qt_child(F,I),P,Q);
                    135:     Ans = append(Ans,[T]);
                    136:   }
                    137:   return Ans;
                    138: }
                    139:
                    140: /* ["f","x"],[["x",[internal,3]]]  $B$N;~$O(B
                    141:    f(3) $B$r7W;;$9$k(B.
                    142: */
                    143: def tr_apply_function0(Q,BindTable) {
                    144:   B = [ ];
                    145:   N = length(BindTable);
                    146:   /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */
                    147:   for (I=0; I<N; I++) {
1.3       takayama  148:     B = append(B,[[BindTable[I][0],"quote("+listtoquote_str(BindTable[I][1])+")"]]);
1.2       takayama  149:   }
                    150:   dprint0("tr_apply_function0: "); dprint(B);
                    151:   N = length(Q)-1; /* $B0z?t$N?t(B */
                    152:   M = length(B);   /*  binding table $B$N%5%$%:(B */
1.3       takayama  153:   R = rtostr(Q[0])+"(";
1.2       takayama  154:   for (I=0; I<N; I++) {
                    155:     X = rtostr(Q[I+1]); /* $BJQ?t(B */
                    156:     /* binding Table $B$r%5!<%A(B */
                    157:     for (J=0; J<M; J++) {
                    158:        Y = rtostr(B[J][0]);
                    159:        if (X == Y) {
                    160:           R = R+B[J][1];
                    161:           if (I != N-1) R = R+",";
                    162:           break;
                    163:        }
1.3       takayama  164:        if (J == M-1) {
                    165:          dprint0("No binding data. Use the X itself. X="); dprint(X);
                    166:          R = R+X;
                    167:          if (I != N-1) R = R+",";
                    168:        }
1.2       takayama  169:     }
                    170:   }
                    171:   R = R+")";
                    172:   dprint0("R="); dprint(R);
1.5     ! takayama  173:   V=eval_str(R);
        !           174:   if (type(V) == 17) return quotetolist(V);
        !           175:   else return V;
1.2       takayama  176: }
                    177:
                    178:
                    179: /* L $B$,:85,B'(B. R $B$,1&5,B'(B.  $BI}M%@hC5:w(B.
                    180:    $B=q$-49$($r$9$k$?$a$N%H%C%W%l%Y%k$N4X?t(B ($B$N$R$H$D(B).
                    181:   $BNc(B:
                    182:     tr_apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),
                    183:                 quote(sin(pn("x")*@pi)),
                    184:                 ["qt_sin_int","x"]);
                    185: */
                    186: def tr_apply_rule1(Obj,L,R) {
                    187:   dprint("--------  start of tr_apply_rule1 ------------ ");
                    188:   Obj = quotetolist(Obj);
                    189:   L = quotetolist(L);
                    190:   R = tr_rp(Obj,L,R);
1.3       takayama  191:   if (type(R) == 17) R=quotetolist(R);
                    192:   RR = "quote("+listtoquote_str(R)+")";
1.2       takayama  193:   dprint("--------  end of tr_apply_rule1 ------------ ");
                    194:   return eval_str(RR);
                    195: }
                    196:
                    197: /* quote $B$KBP$9$k(B $B=R8l(B */
                    198: def qt_is_integer(Qlist) {
1.3       takayama  199:   if (type(Qlist) == 17) Qlist=quotetolist(Qlist);
                    200:   if ((rtostr(Qlist[0]) == "u_op")  && (rtostr(Qlist[1]) == "-")) {
                    201:     return qt_is_integer(cdr(cdr(Qlist))[0]);
                    202:   }
1.2       takayama  203:   if (Qlist[0] == "internal") {
                    204:      Z = eval_str(rtostr(Qlist[1]));
                    205:   }else{
                    206:      return 0;
                    207:   }
                    208:   if (type(Z) == 0) return 1;
                    209:   if ((type(Z) == 1) && (ntype(Z) == 0)) return 1;
                    210:   return 0;
                    211: }
                    212:
                    213: /* quote $B$N@8@.(B */
                    214: /* $B1&5,B'4X?t(B.   0 $B$rLa$9(B. */
                    215: def qt_zero() {
                    216:   return quotetolist(quote(0));
                    217: }
                    218:
                    219: /* $B1&5,B'4X?t(B.   $B91Ey<0(B */
                    220: def qt_id(X) {
1.3       takayama  221:   if (type(X) == 17) return quotetolist(X);
                    222:   else return X;
1.2       takayama  223: }
                    224:
                    225: /* ------------  test --------------------------- */
                    226: extern Rule_test2$
1.3       takayama  227: /* " " $B$HIU$1$F$b$D$1$J$/$F$b$h$$(B. $BFbIt$G(B rtostr $B$7$F$k(B. */
                    228: /* Rule_test2=[quote(sin(pn("x")*@pi)),["qt_sin_int2","x"]]$ */
                    229: Rule_test2=[quote(sin(pn(x)*@pi)),[qt_sin_int2,x]]$
                    230:
1.2       takayama  231:
                    232: def test2() {
                    233:   /* $BI}M%@hC5:w$N>l9g(B, R0 $B$O(B simplify $B$G$-$:(B.  */
                    234:   Rule1=[quote(sin(pn("x")*@pi)),["qt_sin_int","x"]];
                    235:   R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
                    236:   print(print_input_form(R0));
                    237:   R=tr_apply_rule1(R0,Rule1[0],Rule1[1]);
                    238:   print(print_input_form(R));
                    239:   print("-----------------------");
                    240:   /* $B<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */
                    241:   R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
                    242:   print(print_input_form(R0));
                    243:   R=tr_apply_rule1(R0,Rule_test2[0],Rule_test2[1]);
                    244:   print(print_input_form(R));
                    245: }
                    246:
                    247: /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */
                    248: def qt_sin_int(X) {
                    249:   /* $B$$$^(B X $B$O(B quote $B7?(B */
                    250:   Y = quotetolist(X);
                    251:   /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */
1.3       takayama  252:   R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
1.2       takayama  253:   print(R);
                    254:   R = eval_str(R);
                    255:   /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.
                    256:   */
                    257:   if (Y[0] == "internal") {
                    258:      Z = eval_str(rtostr(Y[1]));
                    259:   }else{
                    260:     return quotetolist(R);
                    261:   }
                    262:   if (type(Z) == 0) return quotetolist(quote(0));
                    263:   if ((type(Z) == 1) &&   (ntype(Z) == 0)) return quotetolist(quote(0));
                    264:   return quotetolist(R);
                    265: }
                    266:
                    267: /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */
                    268: def qt_sin_int2(X) {
                    269:   /* tr_apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */
                    270:   X = tr_apply_rule1(X,Rule_test2[0],Rule_test2[1]);
                    271:   Y = quotetolist(X);
1.3       takayama  272:   R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
1.2       takayama  273:   print(R);
                    274:   R = eval_str(R);
                    275:   if (qt_is_integer(Y)) return quotetolist(quote(0));
                    276:   else return quotetolist(R);
                    277: }
                    278:
1.3       takayama  279: /* --------------- end test -----------------------*/
                    280: def qt_replace(F,Rule) {
                    281:   return base_replace(F,Rule);
                    282: }
                    283:
                    284: /*  F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B?
1.5     ! takayama  285:     qt_is_dependent(quotetolist(quote(1+1/x)),x)
1.3       takayama  286: */
1.5     ! takayama  287: def qt_is_dependent(F,X) {
1.3       takayama  288:   if (type(F) == 17) F = quotetolist(F);
                    289:   Node = qt_node(F);
                    290:   if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {
                    291:     return 1;
                    292:   }else{
                    293:      N = qt_nchild(F);
                    294:      for (I=0; I<N;I++) {
                    295:        C = qt_child(F,I);
1.5     ! takayama  296:        if (qt_is_dependent(C,X)) return 1;
1.3       takayama  297:      }
                    298:      return 0;
                    299:   }
                    300: }
                    301:
                    302: /* tr_check_pn $B$NF0:n%F%9%H(B */
                    303: def test2b() {
                    304:   Rule=[quote(sin(pn(x,qt_is_integer(x))*@pi)),[qt_zero]]$
                    305:   R0 = quote(1+sin(2*@pi)*sin(a*@pi));;
                    306:   print(print_input_form(R0));
                    307:   R=tr_apply_rule1(R0,Rule[0],Rule[1]);
                    308:   return R;
                    309: }
                    310:
                    311: /* $BCm0U(B: @pi  $B$b4X?t07$$(B. */
                    312: def qt_is_function(X) {
                    313:   if (type(X) == 17) X=quotetolist(X);
                    314:   if (rtostr(X[0]) == "function") return 1;
                    315:   else return 0;
                    316: }
                    317:
                    318: /* qt_map_arg(nn,quote(f(x,y)))  --> nn(f(nn(x),nn(y)))
                    319:    qt_map_arg(nn,quote(1/4+f(x)))     -->
                    320:    $B%F%9%H$O(B test4().
                    321: */
                    322: def qt_map_arg(F,Q) {
                    323:   F = rtostr(F);
                    324:   if (type(Q) == 17) Q=quotetolist(Q);
                    325:   if (rtostr(Q[0]) == "internal") {
                    326:      T = listtoquote_str(Q);
                    327:      return eval_str( "quote("+F+"("+T+"))" );
                    328:   }
                    329:   /* node $B$N;R6!$r(B F $B$GI>2A$9$k(B. */
                    330:   N = qt_nchild(Q);
                    331:   L = [];
                    332:   for (I=0; I<N; I++) {
                    333:     L = append(L,[quotetolist(qt_map_arg(F,qt_child(Q,I)))]);
                    334:   }
                    335:   dprint0("qt_map_arg:L="); dprint(L);
                    336:   T = [Q[0],Q[1]];
                    337:   for (I=0; I<N; I++) {
                    338:     T = append(T,[L[I]]);
                    339:   }
                    340:   /* $B:G8e$K;R6!$r?F(B Q[0],Q[1] $B$GI>2A$7$F$+$i(B F $B$GI>2A(B */
                    341:   T = ["function",F,T];
                    342:   dprint0("qt_map_arg:T="); dprint(T);
                    343:   T = listtoquote_str(T);
                    344:   return eval_str("quote("+T+")");
1.5     ! takayama  345: }
        !           346:
        !           347: /* Index $BIU$-JQ?t$r<B8=$9$k(B */
        !           348: def idxtov(V,I) {
        !           349:   if (type(I) == 5) I=vtol(I);
        !           350:   if (type(I) != 4) I=[I];
        !           351:   if (type(V) != 2) V=rtostr(V);
        !           352:   return util_v(V,I);
        !           353: }
        !           354:
        !           355: def vtoidx(V) {
        !           356:   A = util_index(V);
        !           357:   if (length(A[1]) == 0) return [A[0]];
        !           358:   if (length(A[1]) == 1) return [A[0],A[1][0]];
        !           359:   return A;
1.3       takayama  360: }
1.2       takayama  361:
                    362: /* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r(B
                    363: */
                    364:
                    365: end$

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>