[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.3 and 1.6

version 1.3, 2005/04/03 11:05:21 version 1.6, 2005/04/21 10:54:50
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.2 2005/04/02 05:56:57 takayama Exp $ */  /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.5 2005/04/15 12:47:14 takayama Exp $ */
 /* $Id$ */  /* $Id$ */
   
 /*  /*
Line 170  def tr_apply_function0(Q,BindTable) {
Line 170  def tr_apply_function0(Q,BindTable) {
   }    }
   R = R+")";    R = R+")";
   dprint0("R="); dprint(R);    dprint0("R="); dprint(R);
   return eval_str(R);    V=eval_str(R);
     if (type(V) == 17) return quotetolist(V);
     else return V;
 }  }
   
   
Line 280  def qt_replace(F,Rule) {
Line 282  def qt_replace(F,Rule) {
 }  }
   
 /*  F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B?  /*  F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B?
     qt_dependent(quotetolist(quote(1+1/x)),x)      qt_is_dependent(quotetolist(quote(1+1/x)),x)
 */  */
 def qt_dependent(F,X) {  def qt_is_dependent(F,X) {
   if (type(F) == 17) F = quotetolist(F);    if (type(F) == 17) F = quotetolist(F);
   Node = qt_node(F);    Node = qt_node(F);
   if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {    if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {
Line 291  def qt_dependent(F,X) {
Line 293  def qt_dependent(F,X) {
      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);
        if (qt_dependent(C,X)) return 1;         if (qt_is_dependent(C,X)) return 1;
      }       }
      return 0;       return 0;
   }    }
Line 342  def qt_map_arg(F,Q) {
Line 344  def qt_map_arg(F,Q) {
   return eval_str("quote("+T+")");    return eval_str("quote("+T+")");
 }  }
   
   /* Index $BIU$-JQ?t$r<B8=$9$k(B */
   def idxtov(V,I) {
     if (type(I) == 5) I=vtol(I);
     if (type(I) != 4) I=[I];
     if (type(V) != 2) V=rtostr(V);
     return util_v(V,I);
   }
   
   def vtoidx(V) {
     A = util_index(V);
     if (length(A[1]) == 0) return [A[0]];
     if (length(A[1]) == 1) return [A[0],A[1][0]];
     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$r(B
 */  */
   
   module qt;
   localf dtoq$
   localf qtod$  /* it has not yet been implemented. /
   localf etoq$
   
   /* Distributed polynomial to quote
      qt.dtoq(dp_ptod((x-y)^3,[x,y]),[]);
   */
   def dtoq(F,V) {
     if (F == 0) return quote(0);
     N = length(dp_etov(F));
     if (N > length(V)) {
       for (I=length(V); I<N; I++) {
         V = append(V,[util_v("x",[I+1])]);
       }
     }
     R = 0;
     while (F != 0) {
       T = dp_hm(F);
       F = dp_rest(F);
       C = objtoquote(dp_hc(T));
       E = dp_etov(T);
       Mq = etoq(E,V);
       if (Mq == quote(1)) {
         R = R+C;
       }else{
         if (C == quote(1)) R = R+Mq;
         else if (C == quote(-1)) R = R-Mq;
         else R = R+C*Mq;
       }
     }
     return R;
   }
   /* bug: +-3*x should be -3*x */
   
   def etoq(E,V) {
     N = length(E);
     if (N > length(V)) {
       for (I=length(V); I<N; I++) {
         V = append(V,[util_v("x",[I+1])]);
       }
     }
     II = -1;
     for (I=0; I<N; I++) {
       if (E[I] != 0) { II=I; break; }
     }
     if (II == -1) return quote(1);
     if (E[II] == 1) R=objtoquote(V[II]);
     else {
       R=objtoquote(V[II])^objtoquote(E[II]);
     }
     for (I=II+1; I<N; I++) {
       if (E[I] != 0) {
         if (E[I] == 1) Rt=objtoquote(V[I]);
         else Rt=objtoquote(V[I])^objtoquote(E[I]);
         R = R*Rt;
       }
     }
     return R;
   }
   
   endmodule;
   
 end$  end$
   

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.6

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