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

Diff for /OpenXM/src/asir-contrib/testing/tr.rr between version 1.6 and 1.7

version 1.6, 2005/04/21 10:54:50 version 1.7, 2005/05/04 05:47:03
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.5 2005/04/15 12:47:14 takayama Exp $ */  /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.6 2005/04/21 10:54:50 takayama Exp $ */
 /* $Id$ */  /* $Id$ */
   
 /*  /*
   OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B.    OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B.
 */  */
 /* $Id$  /*
   $B$3$N%U%!%$%k$O(B quotetolist $B$G%j%9%H$KJQ49$7$?%G!<%?$KBP$7$F(B    $B$3$N%U%!%$%k$O(B quotetolist $B$G%j%9%H$KJQ49$7$?%G!<%?$KBP$7$F(B
   $B%Q%?!<%s%^%C%A$*$h$S$=$l$r1~MQ$7$?JQ7A$r9T$&(B.    $B%Q%?!<%s%^%C%A$*$h$S$=$l$r1~MQ$7$?JQ7A$r9T$&(B.
   tr.oxt $B$N;EMM$H$3$H$J$j(B quotetolist $B$GJQ49$7$?$b$N$r07$&(B.    tr.oxt $B$N;EMM$H$3$H$J$j(B quotetolist $B$GJQ49$7$?$b$N$r07$&(B.
   $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))    $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))
 */  */
   
   
 extern Debug$  extern Debug$
 Debug=0$  Debug=0$
   extern Debug2$  /* For tr.apply_or_rules. $B$H$F$bJXMx(B. */
   Debug2=0$
 def dprint(X) {  def dprint(X) {
   if (Debug) print(X);    if (Debug) print(X);
 }  }
 def dprint0(X) {  def dprint0(X) {
   if (Debug) print(X,0);    if (Debug) print(X,0);
 }  }
   extern Debug2$
   Debug2=0$
   
 /* quotetolist $B$N5U4X?t(B. $B$?$@$7J8;zNs$G(B */  /* quotetolist $B$N5U4X?t(B. $B$?$@$7J8;zNs$G(B */
 def listtoquote_str(L) {  def listtoquote_str(L) {
   return quote_input_form_quote_list(L);    return quote_input_form_quote_list(L);
 }  }
   /* quotetolist $B$N5U4X?t(B. quote $B$rLa$9(B */
   def listtoquote(L) {
     return eval_str("quote("+quote_input_form_quote_list(L)+")");
   }
   
 def qt_node(F) {  /* unix $B$N(B uniq $B$KF1$8(B */
    if (type(F) == 17) F=quotetolist(F);  def uniq(L) {
     N = length(L);
     if (N > 0) A = [L[0]]; else A=[];
     for (I=1; I<N; I++) {
       if (A[0] != L[I]) A=cons(L[I],A);
     }
     return reverse(A);
   }
   /* Global rules */
   extern Rule_test2$
   /* " " $B$HIU$1$F$b$D$1$J$/$F$b$h$$(B. $BFbIt$G(B rtostr $B$7$F$k(B.
      . $B$,IU$$$?$iIU$1$k$7$+$J$$(B.
   */
   /* Rule_test2=[quote(sin(pn("x")*@pi)),["qt.sin_int2","x"]]$ */
   Rule_test2=[quote(sin(pn(x)*@pi)),["qt.sin_int2",x]]$
   
   /* Object id */
   #define O_N 1
   #define O_P 2
   #define O_R 3
   #define O_LIST 4
   #define O_VECT 5
   #define O_MAT 6
   #define O_STR 7
   #define O_COMP 8
   #define O_DP 9
   #define O_USINT 10
   #define O_ERR 11
   #define O_GF2MAT 12
   #define O_MATHCAP 13
   #define O_F 14
   #define O_GFMMAT 15
   #define O_BYTEARRAY 16
   #define O_QUOTE 17
   #define O_OPTLIST 18
   #define O_SYMBOL 19
   #define O_RANGE 20
   #define O_TB 21
   #define O_DPV 22
   #define O_QUOTEARG 23
   #define O_VOID -1
   
   /* Numbers for the first element of quote_to_funargs */
   #define I_BOP 0
   #define I_COP 1
   #define I_AND 2
   #define I_OR 3
   #define I_NOT 4
   #define I_CE 5
   #define I_PRESELF 6
   #define I_POSTSELF 7
   #define I_FUNC 8
   #define I_FUNC_OPT 9
   #define I_IFUNC 10
   #define I_MAP 11
   #define I_RECMAP 12
   #define I_PFDERIV 13
   #define I_ANS 14
   #define I_PVAR 15
   #define I_ASSPVAR 16
   #define I_FORMULA 17
   #define I_LIST 18
   #define I_STR 19
   #define I_NEWCOMP 20
   #define I_CAR 21
   #define I_CDR 22
   #define I_CAST 23
   #define I_INDEX 24
   #define I_EV 25
   #define I_TIMER 26
   #define I_GF2NGEN 27
   #define I_GFPNGEN 28
   #define I_GFSNGEN 29
   #define I_LOP 30
   #define I_OPT 31
   #define I_GETOPT 32
   #define I_POINT 33
   #define I_PAREN 34
   #define I_MINUS 35
   #define I_NARYOP 36
   
   module qt;
   localf node $
   localf nchild $
   localf child $
   localf is_integer $
   localf replace $
   localf is_dependent $
   localf is_function $
   localf map_arg $
   
   localf zero $
   localf id $
   localf one $
   localf plus $
   localf minus $
   localf sin_int $
   localf sin_int2 $
   localf is_rational $
   localf cancel_number $
   /*  2/4 $B$,F~$C$F$k$J$i$P(B 1/2 $B$KJQ99$9$k$J$I(B. tkseries.expand1(1/(1-x),...) */
   localf is_minus $  /* $B@hF,$K(B - $B$,$"$k$+7A<0E*$K$_$k(B. */
   localf add_paren0 $
   localf add_paren $ /* +- $BEy$K(B ( ) $B$r2C$($k(B. */
   localf vars $
   localf etov_pair$
   
   def node(F) {
      if (type(F) == O_QUOTE) F=quotetolist(F);
    return [rtostr(F[0]),rtostr(F[1])];     return [rtostr(F[0]),rtostr(F[1])];
 }  }
 /* Number of  child */  /* Number of  child */
 def qt_nchild(F) {  def nchild(F) {
    if (type(F) == 17) F=quotetolist(F);     if (type(F) == O_QUOTE) F=quotetolist(F);
    return length(F)-2;     return length(F)-2;
 }  }
 def qt_child(F,K) {  def child(F,K) {
    if (type(F) == 17) F=quotetolist(F);     if (type(F) == O_QUOTE) F=quotetolist(F);
    return F[K+2];     return F[K+2];
 }  }
   
   /* quote $B$KBP$9$k(B $B=R8l(B */
   def is_integer(Qlist) {
     if (type(Qlist) == O_QUOTE) Qlist=quotetolist(Qlist);
     if ((rtostr(Qlist[0]) == "u_op")  && (rtostr(Qlist[1]) == "-")) {
       return qt.is_integer(cdr(cdr(Qlist))[0]);
     }
     if (Qlist[0] == "internal") {
        Z = eval_str(rtostr(Qlist[1]));
     }else{
        return 0;
     }
     if (type(Z) == 0) return 1;
     if ((type(Z) == 1) && (ntype(Z) == 0)) return 1;
     return 0;
   }
   
   /* quote $B$N@8@.(B */
   /* $B1&5,B'4X?t(B.   0 $B$rLa$9(B. */
   def zero() {
     return quotetolist(quote(0));
   }
   
   /* $B1&5,B'4X?t(B.   $B91Ey<0(B */
   def id(X) {
     if (type(X) == O_QUOTE) return quotetolist(X);
     else return X;
   }
   
   def one() {
     return quote(1);
   }
   
   def plus(X,Y) {
     if ((type(X) == O_QUOTE) && (type(Y) == O_QUOTE)) return X+Y;
     return ["b_op","+",X,Y];
   }
   
   def minus(X,Y) {
     if ((type(X) == O_QUOTE) && (type(Y) == O_QUOTE)) return X-Y;
     return ["b_op","-",X,Y];
   }
   
   
   /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */
   def sin_int(X) {
     /* $B$$$^(B X $B$O(B quote $B7?(B */
     Y = quotetolist(X);
     /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */
     R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
     print(R);
     R = eval_str(R);
     /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.
     */
     if (Y[0] == "internal") {
        Z = eval_str(rtostr(Y[1]));
     }else{
       return quotetolist(R);
     }
     if (type(Z) == 0) return quotetolist(quote(0));
     if ((type(Z) == 1) &&   (ntype(Z) == 0)) return quotetolist(quote(0));
     return quotetolist(R);
   }
   
   /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */
   def sin_int2(X) {
     /* tr.apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */
     X = tr.apply_rule1(X,Rule_test2[0],Rule_test2[1]);
     Y = quotetolist(X);
     R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
     print(R);
     R = eval_str(R);
     if (qt.is_integer(Y)) return quotetolist(quote(0));
     else return quotetolist(R);
   }
   
   def replace(F,Rule) {
     return base_replace(F,Rule);
   }
   
   /*  F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B?
       qt.is_dependent(quotetolist(quote(1+1/x)),x)
   */
   def is_dependent(F,X) {
     if (type(F) == O_QUOTE) F = quotetolist(F);
     Node = qt.node(F);
     if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {
       return 1;
     }else{
        N = qt.nchild(F);
        for (I=0; I<N;I++) {
          C = qt.child(F,I);
          if (qt.is_dependent(C,X)) return 1;
        }
        return 0;
     }
   }
   
   /* $BCm0U(B: @pi  $B$b4X?t07$$(B. */
   def is_function(X) {
     if (type(X) == O_QUOTE) X=quotetolist(X);
     if (rtostr(X[0]) == "function") return 1;
     else return 0;
   }
   
   /* qt.map_arg(nn,quote(f(x,y)))  --> nn(f(nn(x),nn(y)))
      qt.map_arg(nn,quote(1/4+f(x)))     -->
      $B%F%9%H$O(B test4().
   */
   def map_arg(F,Q) {
     F = rtostr(F);
     if (type(Q) == O_QUOTE) Q=quotetolist(Q);
     if (rtostr(Q[0]) == "internal") {
        T = listtoquote_str(Q);
        return eval_str( "quote("+F+"("+T+"))" );
     }
     /* node $B$N;R6!$r(B F $B$GI>2A$9$k(B. */
     N = qt.nchild(Q);
     L = [];
     for (I=0; I<N; I++) {
       L = append(L,[quotetolist(qt.map_arg(F,qt.child(Q,I)))]);
     }
     dprint0("qt.map_arg:L="); dprint(L);
     T = [Q[0],Q[1]];
     for (I=0; I<N; I++) {
       T = append(T,[L[I]]);
     }
     /* $B:G8e$K;R6!$r?F(B Q[0],Q[1] $B$GI>2A$7$F$+$i(B F $B$GI>2A(B */
     T = ["function",F,T];
     dprint0("qt.map_arg:T="); dprint(T);
     T = listtoquote_str(T);
     return eval_str("quote("+T+")");
   }
   
   /* ($B7A<0E*$K(B) Q $B$KB0$9$k(B quote $B$+(B? */
   def is_rational(X) {
     if (type(X) == O_LIST)  X=listtoquote(X);
     A = quote_to_funargs(X);
     if (A[0] == I_FORMULA) {  /* 1, x */
      if (type(A[1]) <= O_N) return 1;
      else return 0;
     }
     if (A[0] == I_BOP) {  /* 2+3, 2/x */
       Op = get_function_name(A[1]);
       if ((Op == "+") || (Op == "-") || (Op == "*") || (Op == "/")
           || (Op == "^")) {
          if (qt.is_rational(A[2]) && qt.is_rational(A[3])) return 1;
          else return 0;
       }
     }
     if (A[0] == I_PAREN) {
       if (qt.is_rational(A[1])) return 1;
       else return 0;
     }
     if (A[0] == I_MINUS) {
       if (qt.is_rational(A[1])) return 1;
       else return 0;
     }
     return 0;
   }
   
   /* 2/4 --> 1/2 $B$X(B
      $B$3$N<BAu$O8zN($O0-$$(B.
   */
   def cancel_number(Q) {
     if (type(Q) == O_LIST)  Q=listtoquote(Q);
     if (qt.is_rational(Q)) {
       Ans = eval_quote(Q);
       return objtoquote(Ans);
     }
     A = quote_to_funargs(Q);
     N = length(A); R=[];
     for (I=N-1; I>= 0; I--) {
       if (type(A[I]) == O_QUOTE)
         R = cons(qt.cancel_number(A[I]),R);
       else
         R = cons(A[I],R);
     }
     return funargs_to_quote(R);
   }
   
   /* $B@hF,$K(B - $B$,$"$k$+7A<0E*$K$_$k(B.
      -a+b
      -3
      -34/y $BEy(B.
   */
   def is_minus(Q) {
     if (type(Q) == O_LIST)  Q=listtoquote(Q);
     A = quote_to_funargs(Q);
     if (A[0] == I_MINUS) return 1;
     if (A[0] == I_BOP) {
       if (qt.is_minus(A[2])) return 1;
       else return 0;
     }
     return 0;
   }
   /* $BL5>r7o$K(B ( ) $B$r2C$($k(B. */
   def add_paren0(Q) {
     A = [I_PAREN,Q];
     return funargs_to_quote(A);
   }
   /* +- $BEy$K(B ( ) $B$r2C$($k(B.
      $BF0:n$,IT?3$J$N$G(B bug $B$,$"$k$+$b(B.
   */
   def add_paren(Q) {
     if (type(Q) == O_LIST)  Q=listtoquote(Q);
     A = quote_to_funargs(Q);
     /* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */
     N = length(A); R=[];
     for (I=N-1; I>= 0; I--) {
       if (type(A[I]) == O_QUOTE)
         R = cons(qt.add_paren(A[I]),R);
       else
         R = cons(A[I],R);
     }
     A = R;
     if (A[0] == I_BOP) {
        if (get_function_name(A[1]) == "+") {
           if (qt.is_minus(A[3])) {  /* x+-y ==> x+(-y) */
              A2 = [I_BOP,A[1],
                     qt.add_paren(A[2]),
                     qt.add_paren0(A[3])];
              return funargs_to_quote(A2);
           }
        }else if (get_function_name(A[1]) == "*" ||
                  get_function_name(A[1]) == "/")
        {
           if (qt.is_minus(A[2])) {  /* -x*y ==> (-x)*y */
              A2 = [I_BOP,A[1],
                     qt.add_paren0(A[2]),
                     qt.add_paren(A[3])];
              return funargs_to_quote(A2);
           }
        }
     }
     return funargs_to_quote(A);
   }
   
   /* vars $B$N??;w(B.
      $B$3$N4X?t$b(B $BJQ?t$N=P8=2s?tJ,$N%j%9%H$r:n$k$N$G8zN($o$k$$(B.
    */
   def vars(Q) {
     R = [ ];
     if (type(Q) == O_LIST)  Q=listtoquote(Q);
     A = quote_to_funargs(Q);
     if (A[0] == I_FORMULA) {
       if (type(A[1]) == O_P) {
          R = cons(A[1],R);
       }
     }
     /* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */
     N = length(A);
     for (I=1; I<N; I++) {
       if (type(A[I]) == O_QUOTE)
         R = append(qt.vars(A[I]),R);
     }
     R=qsort(R);
     R=uniq(R);
     return reverse(R);
   }
   
   /* p^q $B$r:F5"$GC5$7$F(B [p,q] $B$rLa$9(B. */
   def etov_pair(Q) {
     R = [ ];
     if (type(Q) == O_LIST)  Q=listtoquote(Q);
     A = quote_to_funargs(Q);
     if (A[0] == I_BOP) {
       if (get_function_name(A[1]) == "^") {
          R=[[A[2],A[3]]];
       }
     }
     /* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */
     N = length(A);
     for (I=1; I<N; I++) {
       if (type(A[I]) == O_QUOTE)
         R = append(qt.etov_pair(A[I]),R);
     }
     return R;
   }
   
   endmodule$
   
   module tr;
   localf match0$
   localf check_pn$
   localf make_binding$
   localf rp$
   localf apply_function0$
   localf apply_rule1$
   localf rp_flag$
   localf apply_rule1_flag$
   localf apply_or_rules$
   
 /*  /*
    $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.     $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.
    $B$=$&$G$J$$$+$i(B 0.  $BI}M%@hC5:w(B.     $B$=$&$G$J$$$+$i(B 0.  $BI}M%@hC5:w(B.
     Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.      Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.
 */  */
 def tr_match0(F,P)  {  def match0(F,P)  {
   dprint0("tr_match0: F="); dprint(F);    dprint0("tr.match0: F="); dprint(F);
   dprint0("tr_match0: P="); dprint(P);    dprint0("tr.match0: P="); dprint(P);
   
   if (type(F) != type(P)) return 0;    if (type(F) != type(P)) return 0;
   if (type(F) != 4) {    if (type(F) != O_LIST) {
     if (F == P) return 1;      if (F == P) return 1;
     else return 0;      else return 0;
   }    }
   Node = qt_node(F);    Node = qt.node(F);
   Node2 = qt_node(P);    Node2 = qt.node(P);
   /* pn $B$K2?$N@)Ls$b$J$1$l$P(B 2 $B$rLa$9(B. */    /* pn $B$K2?$N@)Ls$b$J$1$l$P(B 2 $B$rLa$9(B. */
   if (Node2 == ["function","pn"]) return tr_check_pn(F,P);    if (Node2 == ["function","pn"]) return tr.check_pn(F,P);
   if (Node != Node2) return 0;    if (Node != Node2) return 0;
   N = qt_nchild(F);    N = qt.nchild(F);
   if (N != qt_nchild(P)) return 0;    if (N != qt.nchild(P)) return 0;
   for (I=0; I<N; I++) {    for (I=0; I<N; I++) {
      C = qt_child(F,I);       C = qt.child(F,I);
      C2 = qt_child(P,I);       C2 = qt.child(P,I);
      if (!tr_match0(C,C2)) return 0;       if (!tr.match0(C,C2)) return 0;
   }    }
   return 1;    return 1;
 }  }
   
 /*  /*
    P $B$NNc(B: P = pn("x");  P=pn("x",qt_is_integer(x));     P $B$NNc(B: P = pn("x");  P=pn("x",qt.is_integer(x));
    P $B$O(B [function,pn,[internal,x],[function,is_int,[internal,x]]]     P $B$O(B [function,pn,[internal,x],[function,is_int,[internal,x]]]
    FF $B$O(B ["is_int","x"]     FF $B$O(B ["is_int","x"]
    $B%F%9%H%G!<%?(B.     $B%F%9%H%G!<%?(B.
  tr_check_pn(quote(1/2),quote(pn("x",qt_is_integer(x))));   tr.check_pn(quote(1/2),quote(pn("x",qt.is_integer(x))));
 */  */
 def tr_check_pn(F,P) {  def check_pn(F,P) {
   if (type(F) ==17) F=quotetolist(F);    if (type(F) ==O_QUOTE) F=quotetolist(F);
   if (type(P) == 17) P=quotetolist(P);    if (type(P) == O_QUOTE) P=quotetolist(P);
   N=qt_nchild(P);    N=qt.nchild(P);
   if (N == 1) return 2;    if (N == 1) return 2;
   X = rtostr(qt_child(P,0)[1]);    X = rtostr(qt.child(P,0)[1]);
   BindingTable = [[X,F]];    BindingTable = [[X,F]];
   FF = [rtostr(qt_child(P,1)[1]),rtostr(qt_child(P,1)[2][1])];    FF = [rtostr(qt.child(P,1)[1]),rtostr(qt.child(P,1)[2][1])];
   R = tr_apply_function0(FF,BindingTable);    R = tr.apply_function0(FF,BindingTable);
   return R;    return R;
 }  }
   
 /* F $B$H(B P $B$,(B tr_match0 $B$9$k$H$-(B  bindingTable $B$r$b$I$9(B.  /* F $B$H(B P $B$,(B tr.match0 $B$9$k$H$-(B  bindingTable $B$r$b$I$9(B.
   [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]    [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]
 */  */
 def tr_make_binding(F,P) {  def make_binding(F,P) {
   Ans = [ ];    Ans = [ ];
   if (F == P) return Ans;    if (F == P) return Ans;
   
   Node = qt_node(F);    Node = qt.node(F);
   Node2 = qt_node(P);    Node2 = qt.node(P);
   
   if (Node2 == ["function", "pn"]) {    if (Node2 == ["function", "pn"]) {
      Ans = append(Ans,[[rtostr(P[2][1]),F]]);       Ans = append(Ans,[[rtostr(P[2][1]),F]]);
      return Ans;       return Ans;
   }    }
   N = qt_nchild(F);    N = qt.nchild(F);
   for (I=0; I<N; I++) {    for (I=0; I<N; I++) {
      C = qt_child(F,I);       C = qt.child(F,I);
      C2 = qt_child(P,I);       C2 = qt.child(P,I);
      Ans = append(Ans,tr_make_binding(C,C2));       Ans = append(Ans,tr.make_binding(C,C2));
   }    }
   return Ans;    return Ans;
 }  }
Line 117  def tr_make_binding(F,P) {
Line 526  def tr_make_binding(F,P) {
    $B?<$5M%@hC5:w$K$7$?(B --> action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B.     $B?<$5M%@hC5:w$K$7$?(B --> action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B.
    Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.     Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.
 */  */
 def tr_rp(F,P,Q) {  def rp(F,P,Q) {
   dprint0("tr_rp, F="); dprint(F);    dprint0("tr.rp, F="); dprint(F);
   dprint0("tr_rp, P="); dprint(P);    dprint0("tr.rp, P="); dprint(P);
   dprint0("tr_rp, Q="); dprint(Q);    dprint0("tr.rp, Q="); dprint(Q);
   if (tr_match0(F,P)) {    if (tr.match0(F,P)) {
      BindTable = tr_make_binding(F,P);       BindTable = tr.make_binding(F,P);
      dprint0("BindTable="); dprint(BindTable);       dprint0("BindTable="); dprint(BindTable);
      return tr_apply_function0(Q,BindTable);       return tr.apply_function0(Q,BindTable);
   }    }
   if (type(F) != 4) return F;    if (type(F) != O_LIST) return F;
   Node = qt_node(F);    Node = qt.node(F);
   N = qt_nchild(F);    N = qt.nchild(F);
   Ans = Node;    Ans = Node;
   for (I=0; I<N; I++) {    for (I=0; I<N; I++) {
     T = tr_rp(qt_child(F,I),P,Q);      T = tr.rp(qt.child(F,I),P,Q);
     Ans = append(Ans,[T]);      Ans = append(Ans,[T]);
   }    }
   return Ans;    return Ans;
Line 140  def tr_rp(F,P,Q) {
Line 549  def tr_rp(F,P,Q) {
 /* ["f","x"],[["x",[internal,3]]]  $B$N;~$O(B  /* ["f","x"],[["x",[internal,3]]]  $B$N;~$O(B
    f(3) $B$r7W;;$9$k(B.     f(3) $B$r7W;;$9$k(B.
 */  */
 def tr_apply_function0(Q,BindTable) {  def apply_function0(Q,BindTable) {
   B = [ ];    B = [ ];
   N = length(BindTable);    N = length(BindTable);
   /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */    /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */
   for (I=0; I<N; I++) {    for (I=0; I<N; I++) {
     B = append(B,[[BindTable[I][0],"quote("+listtoquote_str(BindTable[I][1])+")"]]);      B = append(B,[[BindTable[I][0],"quote("+listtoquote_str(BindTable[I][1])+")"]]);
   }    }
   dprint0("tr_apply_function0: "); dprint(B);    dprint0("tr.apply_function0: "); dprint(B);
   N = length(Q)-1; /* $B0z?t$N?t(B */    N = length(Q)-1; /* $B0z?t$N?t(B */
   M = length(B);   /*  binding table $B$N%5%$%:(B */    M = length(B);   /*  binding table $B$N%5%$%:(B */
   R = rtostr(Q[0])+"(";    R = rtostr(Q[0])+"(";
Line 171  def tr_apply_function0(Q,BindTable) {
Line 580  def tr_apply_function0(Q,BindTable) {
   R = R+")";    R = R+")";
   dprint0("R="); dprint(R);    dprint0("R="); dprint(R);
   V=eval_str(R);    V=eval_str(R);
   if (type(V) == 17) return quotetolist(V);    if (type(V) == O_QUOTE) return quotetolist(V);
   else return V;    else return V;
 }  }
   
Line 179  def tr_apply_function0(Q,BindTable) {
Line 588  def tr_apply_function0(Q,BindTable) {
 /* L $B$,:85,B'(B. R $B$,1&5,B'(B.  $BI}M%@hC5:w(B.  /* L $B$,:85,B'(B. R $B$,1&5,B'(B.  $BI}M%@hC5:w(B.
    $B=q$-49$($r$9$k$?$a$N%H%C%W%l%Y%k$N4X?t(B ($B$N$R$H$D(B).     $B=q$-49$($r$9$k$?$a$N%H%C%W%l%Y%k$N4X?t(B ($B$N$R$H$D(B).
   $BNc(B:    $BNc(B:
     tr_apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),      tr.apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),
                 quote(sin(pn("x")*@pi)),                  quote(sin(pn("x")*@pi)),
                 ["qt_sin_int","x"]);                  ["qt.sin_int","x"]);
 */  */
 def tr_apply_rule1(Obj,L,R) {  def apply_rule1(Obj,L,R) {
   dprint("--------  start of tr_apply_rule1 ------------ ");    dprint("--------  start of tr.apply_rule1 ------------ ");
   Obj = quotetolist(Obj);    Obj = quotetolist(Obj);
   L = quotetolist(L);    L = quotetolist(L);
   R = tr_rp(Obj,L,R);    R = tr.rp(Obj,L,R);
   if (type(R) == 17) R=quotetolist(R);    if (type(R) == O_QUOTE) R=quotetolist(R);
   RR = "quote("+listtoquote_str(R)+")";    RR = "quote("+listtoquote_str(R)+")";
   dprint("--------  end of tr_apply_rule1 ------------ ");    dprint("--------  end of tr.apply_rule1 ------------ ");
   return eval_str(RR);    return eval_str(RR);
 }  }
   
 /* quote $B$KBP$9$k(B $B=R8l(B */  /* Flag $BIU$-(B $B$N(B tr.rp. $BB0@-$,$J$$$N$G$3$l$G$d$k(B. */
 def qt_is_integer(Qlist) {  def rp_flag(F,P,Q) {
   if (type(Qlist) == 17) Qlist=quotetolist(Qlist);    Flag = 0;
   if ((rtostr(Qlist[0]) == "u_op")  && (rtostr(Qlist[1]) == "-")) {    dprint0("tr.rp, F="); dprint(F);
     return qt_is_integer(cdr(cdr(Qlist))[0]);    dprint0("tr.rp, P="); dprint(P);
     dprint0("tr.rp, Q="); dprint(Q);
     if (tr.match0(F,P)) {
        BindTable = tr.make_binding(F,P);
        dprint0("BindTable="); dprint(BindTable);
        return [1,tr.apply_function0(Q,BindTable)];
   }    }
   if (Qlist[0] == "internal") {    if (type(F) != O_LIST) return F;
      Z = eval_str(rtostr(Qlist[1]));    Node = qt.node(F);
   }else{    N = qt.nchild(F);
      return 0;    Ans = Node;
     for (I=0; I<N; I++) {
       T = tr.rp_flag(qt.child(F,I),P,Q);
       if (T[0] == 1) Flag = 1;
       Ans = append(Ans,[T[1]]);
   }    }
   if (type(Z) == 0) return 1;    return [Flag,Ans];
   if ((type(Z) == 1) && (ntype(Z) == 0)) return 1;  
   return 0;  
 }  }
   
 /* quote $B$N@8@.(B */  /* $B=q$-49$((B flag $BIU$-$N(B tr.apply_rule_flag */
 /* $B1&5,B'4X?t(B.   0 $B$rLa$9(B. */  def apply_rule1_flag(Obj,L,R) {
 def qt_zero() {    Flag = 0;
   return quotetolist(quote(0));    if (Debug2)
      print("--------  start of tr.apply_rule1_flag ------------ ");
     if (Debug2) print(print_input_form(Obj));
     Obj = quotetolist(Obj);
     L = quotetolist(L);
     R = tr.rp_flag(Obj,L,R);
     Flag=R[0]; R=R[1];
     if (type(R) == O_QUOTE) R=quotetolist(R);
     RR = "quote("+listtoquote_str(R)+")";
     if (Debug2) {print("==> "+RR+"  by  "); print(listtoquote_str(L));}
     if (Debug2) print("--------  end of tr.apply_rule1_flag ------------ ");
     return [Flag,eval_str(RR)];
 }  }
   
 /* $B1&5,B'4X?t(B.   $B91Ey<0(B */  def apply_or_rules(Q,R) {
 def qt_id(X) {    Flag = 1;
   if (type(X) == 17) return quotetolist(X);    N = length(R);
   else return X;    while (Flag) {
      Flag = 0;
      for (I=0; I<N; I++) {
        Q = tr.apply_rule1_flag(Q,R[I][0],R[I][1]);
        if (Q[0]) {
          Flag = 1;
          dprint("Applied the rule "+rtostr(I));
        }
        Q = Q[1];
      }
     }
     return Q;
 }  }
   
   endmodule$
   
   
   /* tr $B$N=q$-49$(%k!<%k(B */
   module tr;
   localf simp_zero$
   localf simp_unary$
   localf simp_sin$
   /* 0+any, 0*any $B$K$J$k(B quote $B$r(B 0 $B$K$9$k(B. $BI,?\(B. cf. taka_series.expand1
      test_0();  $B$G%F%9%H$9$k(B.
   */
   def simp_zero(R0) {
     Rule1=[quote(0*pn(y)),       ["qt.zero"]];       /* 0*any --> 0 */
     Rule2=[quote(pn(y)*0),       ["qt.zero"]];       /* any*0 --> 0 */
     Rule3=[quote(0/pn(y)),       ["qt.zero"]];       /* 0/any --> 0 */
     Rule4=[quote(pn(y)+0),       ["qt.id",y]];       /* any+0 --> any */
     Rule5=[quote(0+pn(y)),       ["qt.id",y]];       /* 0+any --> any */
     Rule6=[quote(-0),            ["qt.zero",y]];       /* -0 --> 0 */
     Rule7=[quote((0)),            ["qt.zero",y]];       /* (0) --> 0 */
     Rule8=[quote(1*pn(y)),       ["qt.id",y]];       /* 1*any --> any */
     Rule9=[quote(pn(y)*1),       ["qt.id",y]];       /* any*1 --> any */
     R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5, Rule6,Rule7,
                             Rule8, Rule9]);
     return R;
   }
   
   def simp_unary(R0) {
     Rule1=[quote(pn(x))+quote(-pn(y)), ["qt.minus",x,y]];  /* x+-y -> x-y */
     Rule2=[quote(-(-pn(x))), ["qt.id",x]];  /* -(-x) --> x */
     Rule3=[quote(pn(x)-(-pn(y))), ["qt.plus",x,y]];  /* x-(-y) --> x+y */
     R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3]);
     return R;
   }
   
   /*
     test_1() $B$O%5%s%W%k%F%9%H(B.
   */
   def simp_sin(R0) {
     Rule1=[quote(sin(pn(x)*@pi)),["qt.sin_int",x]]; /* sin($B@0?t(B*@pi) --> 0 */
     Rule2=[quote(0*pn(y)),       ["qt.zero"]];       /* 0*any --> 0 */
     Rule3=[quote(pn(y)*0),       ["qt.zero"]];       /* any*0 --> 0 */
     Rule4=[quote(pn(y)+0),       ["qt.id",y]];       /* any+0 --> any */
     Rule5=[quote(0+pn(y)),       ["qt.id",y]];       /* 0+any --> any */
     Rule6=[quote(sin(0)),        ["qt.zero"]];       /* sin(0) --> 0 */
     Rule7=[quote(cos(0)),        ["qt.one"]];         /* cos(0) --> 1 */
     /* print(print_input_form(R0)); */
     R=tr.apply_rule1_flag(R0,Rule1[0],Rule1[1]);
     /* print([R[0],print_input_form(R[1])]); */
     R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5,Rule6,Rule7]);
     return R;
   }
   
   endmodule$
 /* ------------  test --------------------------- */  /* ------------  test --------------------------- */
 extern Rule_test2$  
 /* " " $B$HIU$1$F$b$D$1$J$/$F$b$h$$(B. $BFbIt$G(B rtostr $B$7$F$k(B. */  
 /* Rule_test2=[quote(sin(pn("x")*@pi)),["qt_sin_int2","x"]]$ */  
 Rule_test2=[quote(sin(pn(x)*@pi)),[qt_sin_int2,x]]$  
   
   
   
 def test2() {  def test2() {
   /* $BI}M%@hC5:w$N>l9g(B, R0 $B$O(B simplify $B$G$-$:(B.  */    /* $BI}M%@hC5:w$N>l9g(B, R0 $B$O(B simplify $B$G$-$:(B.  */
   Rule1=[quote(sin(pn("x")*@pi)),["qt_sin_int","x"]];    Rule1=[quote(sin(pn("x")*@pi)),["qt.sin_int","x"]];
   R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));    R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
   print(print_input_form(R0));    print(print_input_form(R0));
   R=tr_apply_rule1(R0,Rule1[0],Rule1[1]);    R=tr.apply_rule1(R0,Rule1[0],Rule1[1]);
   print(print_input_form(R));    print(print_input_form(R));
   print("-----------------------");    print("-----------------------");
   /* $B<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */    /* $B<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */
   R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));    R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
   print(print_input_form(R0));    print(print_input_form(R0));
   R=tr_apply_rule1(R0,Rule_test2[0],Rule_test2[1]);    R=tr.apply_rule1(R0,Rule_test2[0],Rule_test2[1]);
   print(print_input_form(R));    print(print_input_form(R));
 }  }
   
 /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */  
 def qt_sin_int(X) {  
   /* $B$$$^(B X $B$O(B quote $B7?(B */  
   Y = quotetolist(X);  
   /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */  
   R = "quote(sin("+listtoquote_str(Y)+"*@pi))";  
   print(R);  
   R = eval_str(R);  
   /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.  
   */  
   if (Y[0] == "internal") {  
      Z = eval_str(rtostr(Y[1]));  
   }else{  
     return quotetolist(R);  
   }  
   if (type(Z) == 0) return quotetolist(quote(0));  
   if ((type(Z) == 1) &&   (ntype(Z) == 0)) return quotetolist(quote(0));  
   return quotetolist(R);  
 }  
   
 /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */  /* tr.check_pn $B$NF0:n%F%9%H(B */
 def qt_sin_int2(X) {  
   /* tr_apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */  
   X = tr_apply_rule1(X,Rule_test2[0],Rule_test2[1]);  
   Y = quotetolist(X);  
   R = "quote(sin("+listtoquote_str(Y)+"*@pi))";  
   print(R);  
   R = eval_str(R);  
   if (qt_is_integer(Y)) return quotetolist(quote(0));  
   else return quotetolist(R);  
 }  
   
 /* --------------- end test -----------------------*/  
 def qt_replace(F,Rule) {  
   return base_replace(F,Rule);  
 }  
   
 /*  F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B?  
     qt_is_dependent(quotetolist(quote(1+1/x)),x)  
 */  
 def qt_is_dependent(F,X) {  
   if (type(F) == 17) F = quotetolist(F);  
   Node = qt_node(F);  
   if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {  
     return 1;  
   }else{  
      N = qt_nchild(F);  
      for (I=0; I<N;I++) {  
        C = qt_child(F,I);  
        if (qt_is_dependent(C,X)) return 1;  
      }  
      return 0;  
   }  
 }  
   
 /* tr_check_pn $B$NF0:n%F%9%H(B */  
 def test2b() {  def test2b() {
   Rule=[quote(sin(pn(x,qt_is_integer(x))*@pi)),[qt_zero]]$    Rule=[quote(sin(pn(x,qt.is_integer(x))*@pi)),["qt.zero"]]$
   R0 = quote(1+sin(2*@pi)*sin(a*@pi));;    R0 = quote(1+sin(2*@pi)*sin(a*@pi));;
   print(print_input_form(R0));    print(print_input_form(R0));
   R=tr_apply_rule1(R0,Rule[0],Rule[1]);    R=tr.apply_rule1(R0,Rule[0],Rule[1]);
   return R;    return R;
 }  }
   
 /* $BCm0U(B: @pi  $B$b4X?t07$$(B. */  /* tr.simp_zero $B$N%F%9%H(B */
 def qt_is_function(X) {  def test_0() {
   if (type(X) == 17) X=quotetolist(X);    F = quote(x+(0*x+0));
   if (rtostr(X[0]) == "function") return 1;    print(quote_input_form(F));
   else return 0;    return tr.simp_zero(F);
 }  }
   
 /* qt_map_arg(nn,quote(f(x,y)))  --> nn(f(nn(x),nn(y)))  /* tr.simp_sin $B$N%F%9%H(B */
    qt_map_arg(nn,quote(1/4+f(x)))     -->  def test_1() {
    $B%F%9%H$O(B test4().    F = quote(sin(sin(0))+sin(0));
 */    print(quote_input_form(F));
 def qt_map_arg(F,Q) {    return tr.simp_sin(F);
   F = rtostr(F);  
   if (type(Q) == 17) Q=quotetolist(Q);  
   if (rtostr(Q[0]) == "internal") {  
      T = listtoquote_str(Q);  
      return eval_str( "quote("+F+"("+T+"))" );  
   }  
   /* node $B$N;R6!$r(B F $B$GI>2A$9$k(B. */  
   N = qt_nchild(Q);  
   L = [];  
   for (I=0; I<N; I++) {  
     L = append(L,[quotetolist(qt_map_arg(F,qt_child(Q,I)))]);  
   }  
   dprint0("qt_map_arg:L="); dprint(L);  
   T = [Q[0],Q[1]];  
   for (I=0; I<N; I++) {  
     T = append(T,[L[I]]);  
   }  
   /* $B:G8e$K;R6!$r?F(B Q[0],Q[1] $B$GI>2A$7$F$+$i(B F $B$GI>2A(B */  
   T = ["function",F,T];  
   dprint0("qt_map_arg:T="); dprint(T);  
   T = listtoquote_str(T);  
   return eval_str("quote("+T+")");  
 }  }
   
   /* ------------------------------------------------ */
   
 /* Index $BIU$-JQ?t$r<B8=$9$k(B */  /* Index $BIU$-JQ?t$r<B8=$9$k(B */
 def idxtov(V,I) {  def idxtov(V,I) {
   if (type(I) == 5) I=vtol(I);    if (type(I) == 5) I=vtol(I);
   if (type(I) != 4) I=[I];    if (type(I) != O_LIST) I=[I];
   if (type(V) != 2) V=rtostr(V);    if (type(V) != 2) V=rtostr(V);
   return util_v(V,I);    return util_v(V,I);
 }  }
Line 364  def vtoidx(V) {
Line 778  def vtoidx(V) {
   
 module qt;  module qt;
 localf dtoq$  localf dtoq$
 localf qtod$  /* it has not yet been implemented. /  localf qtod$  /* it has not yet been implemented. */
 localf etoq$  localf etoq$
   
 /* Distributed polynomial to quote  /* Distributed polynomial to quote
Line 383  def dtoq(F,V) {
Line 797  def dtoq(F,V) {
     T = dp_hm(F);      T = dp_hm(F);
     F = dp_rest(F);      F = dp_rest(F);
     C = objtoquote(dp_hc(T));      C = objtoquote(dp_hc(T));
       if (qt.is_minus(C)) {
         C = qt.add_paren0(C);
       }
     E = dp_etov(T);      E = dp_etov(T);
     Mq = etoq(E,V);      Mq = etoq(E,V);
     if (Mq == quote(1)) {      if (Mq == quote(1)) {
Line 395  def dtoq(F,V) {
Line 812  def dtoq(F,V) {
   }    }
   return R;    return R;
 }  }
 /* bug: +-3*x should be -3*x */  
   
 def etoq(E,V) {  def etoq(E,V) {
   N = length(E);    N = length(E);
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>