[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.7 and 1.8

version 1.7, 2005/05/04 05:47:03 version 1.8, 2005/05/11 06:40:10
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.6 2005/04/21 10:54:50 takayama Exp $ */  /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.7 2005/05/04 05:47:03 takayama Exp $ */
 /* $Id$ */  /* $Id$ */
   
 /*  /*
Line 43  def uniq(L) {
Line 43  def uniq(L) {
   }    }
   return reverse(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 */  /* Object id */
 #define O_N 1  #define O_N 1
 #define O_P 2  #define O_P 2
Line 141  localf add_paren0 $ 
Line 135  localf add_paren0 $ 
 localf add_paren $ /* +- $BEy$K(B ( ) $B$r2C$($k(B. */  localf add_paren $ /* +- $BEy$K(B ( ) $B$r2C$($k(B. */
 localf vars $  localf vars $
 localf etov_pair$  localf etov_pair$
   localf hm $
   localf rest $
   localf hop $
   localf input_form $
   
 def node(F) {  def node(F) {
    if (type(F) == O_QUOTE) F=quotetolist(F);     if (type(F) == O_QUOTE) F=quotetolist(F);
Line 212  def sin_int(X) {
Line 210  def sin_int(X) {
   if (Y[0] == "internal") {    if (Y[0] == "internal") {
      Z = eval_str(rtostr(Y[1]));       Z = eval_str(rtostr(Y[1]));
   }else{    }else{
     return quotetolist(R);      return R;
   }    }
   if (type(Z) == 0) return quotetolist(quote(0));    if (type(Z) == 0) return quote(0);
   if ((type(Z) == 1) &&   (ntype(Z) == 0)) return quotetolist(quote(0));    if ((type(Z) == 1) &&   (ntype(Z) == 0)) return quote(0);
   return quotetolist(R);    return R;
 }  }
   
 /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */  /* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */
Line 227  def sin_int2(X) {
Line 225  def sin_int2(X) {
   R = "quote(sin("+listtoquote_str(Y)+"*@pi))";    R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
   print(R);    print(R);
   R = eval_str(R);    R = eval_str(R);
   if (qt.is_integer(Y)) return quotetolist(quote(0));    if (qt.is_integer(Y)) return quote(0);
   else return quotetolist(R);    else return R;
 }  }
   
 def replace(F,Rule) {  def replace(F,Rule) {
Line 435  def etov_pair(Q) {
Line 433  def etov_pair(Q) {
   return R;    return R;
 }  }
   
   /* dp_hm + dp_rest $B$N%"%J%m%8!<(B.
      $B$?$@$7(B * $BEy(B binary operator $B$G>o$KF0:n(B.
      $BNc(B:  Q=h*r*r2  --> hm(Q)=h, rest(Q)=r*r2, hop(Q)="*".
      $B$?$@$7(B rest $B$G(B quote $B$O(B $B:87k9gE*$KJQ99(B. flatten_quote().
   */
   def hm(Q) {
     if (type(Q) == O_LIST) Q = listtoquote(Q);
     A=quote_to_funargs(Q);
     if (A[0] == I_BOP) {
       Op = get_function_name(A[1]);
       if (Op == "+") {
         return A[2];
       }else if (Op == "-") {
         return A[2];
       }else if (Op == "*") {
         return A[2];
       }else if (Op == "/") {
         return A[2];
       }else if (Op == "^") {
         return A[2];
       }
     }
     return Q;
   }
   
   def rest(Q) {
     if (type(Q) == O_LIST) Q = listtoquote(Q);
     A=quote_to_funargs(Q);
     if (A[0] == I_BOP) {
       Op = get_function_name(A[1]);
       if (Op == "+") {
         return flatten_quote(A[3],"+");
       }else if (Op == "-") {
         return "not implented to return -A[3]";
       }else if (Op == "*") {
         return flatten_quote(A[3],"*");
       }else if (Op == "/") {
         return flatten_quote(A[3],"/");
       }else if (Op == "^") {
         return flatten_quote(A[3],"^");
       }else return 0;
     }
     return 0;
   }
   
   def hop(Q) {
     if (type(Q) == O_LIST) Q = listtoquote(Q);
     A=quote_to_funargs(Q);
     if (A[0] == I_BOP) return get_function_name(A[1]);
     return 0;
   }
   
   def input_form(Q) {
     T = type(Q);
     if ((T == O_VECT) || (T == O_MAT)) {
        Q = matrix_matrix_to_list(Q);
     }
     if (type(Q) == O_LIST) {
       A = [];
       for (I=length(Q)-1; I>=0; I--) {
          A = cons(qt.input_form(Q[I]),A);
       }
       if ((T == O_VECT) || (T == O_MAT)) { A = matrix_list_to_matrix(A); }
       return A;
     }
     if (T == O_QUOTE) return quote_input_form(Q);
     return rtostr(Q);
   }
 endmodule$  endmodule$
   
 module tr;  module tr;
Line 448  localf rp_flag$
Line 514  localf rp_flag$
 localf apply_rule1_flag$  localf apply_rule1_flag$
 localf apply_or_rules$  localf apply_or_rules$
   
   static Rule_test2$   /* int_sin2 $B$,MxMQ(B */
   /* " " $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]]$
   
 /*  /*
    $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.
Line 458  def match0(F,P)  {
Line 531  def match0(F,P)  {
   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) == O_QUOTE) {F=quotetolist(F); P=quotetolist(P);}
   if (type(F) != O_LIST) {    if (type(F) != O_LIST) {
     if (F == P) return 1;      if (F == P) return 1;
     else return 0;      else return 0;
Line 482  def match0(F,P)  {
Line 556  def match0(F,P)  {
    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 check_pn(F,P) {  def check_pn(F,P) {
   if (type(F) ==O_QUOTE) F=quotetolist(F);    if (type(F) ==O_QUOTE) F=quotetolist(F);
   if (type(P) == O_QUOTE) P=quotetolist(P);    if (type(P) == O_QUOTE) P=quotetolist(P);
     /* print(F);print(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])]; */
     FF = [rtostr(qt.child(P,1)[1])];
     M = length(qt.child(P,1));
     for (I=2; I<M; I++) {
       FF = append(FF,[rtostr(qt.child(P,1)[I][1])]);
     }
     /* print(FF); print(BindingTable); */
   R = tr.apply_function0(FF,BindingTable);    R = tr.apply_function0(FF,BindingTable);
   return R;    return R;
 }  }
Line 773  def vtoidx(V) {
Line 854  def vtoidx(V) {
   return A;    return A;
 }  }
   
 /* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r(B  /* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r8+$h(B.
 */  */
   
 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$
   localf hc_etov$
   
 /* Distributed polynomial to quote  /* Distributed polynomial to quote
    qt.dtoq(dp_ptod((x-y)^3,[x,y]),[]);     qt.dtoq(dp_ptod((x-y)^3,[x,y]),[]);
Line 810  def dtoq(F,V) {
Line 892  def dtoq(F,V) {
       else R = R+C*Mq;        else R = R+C*Mq;
     }      }
   }    }
   return R;    return flatten_quote(R,"+");
 }  }
   
 def etoq(E,V) {  def etoq(E,V) {
Line 836  def etoq(E,V) {
Line 918  def etoq(E,V) {
       R = R*Rt;        R = R*Rt;
     }      }
   }    }
   return R;    return flatten_quote(R,"*");
 }  }
   
   def hc_etov(Q,V) {
     HC=quote(1);
     N = length(V);
     E = newvect(N);
     while (type(Q) != 0) {
       Q = flatten_quote(Q,"*");
       A = quote_to_funargs(Q);
       Sign = 1;
       if (A[0] == I_MINUS) {
         Sign = -1;
         Q = A[1];
       }
       Q = flatten_quote(Q,"*");
       Op=qt.hop(Q);
       if (Op != "*") {
         F=Q; if (Sign == -1) F = quote((-1))*F;
         Q=0;
       }else{
         F=qt.hm(Q); if (Sign == -1) F = quote((-1))*F;
         Q=qt.rest(Q);
       }
   
       print(quote_input_form(F));
       print(Op);
       print(quote_input_form(Q));
       Const = 1;
       for (I=0; I<N; I++) {
         if (qt.is_dependent(F,V[I])) {
           Const = 0;
           EE=qt.etov_pair(F);
           if (EE != []) E[I] = EE[0][1];
           else E[I] = quote(1);
         }
       }
       if (Const) HC=HC*F;
     }
     return [HC,E];
   }
   
 endmodule;  endmodule;
   
   
   
   
 end$  end$
   
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>