OpenXM/src/asir-contrib/testing/tr.rr - diff

Return to tr.rr CVS log

Up to [local] / OpenXM / src / asir-contrib / testing

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

-version 1.4, 2005/04/06 09:26:28
+version 1.6, 2005/04/21 10:54:50
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.3 2005/04/03 11:05:21 takayama Exp $ */
+ /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.5 2005/04/15 12:47:14 takayama Exp $ */
  /* $Id$ */
  /*
 Line 170  def tr_apply_function0(Q,BindTable) {
 Line 170  def tr_apply_function0(Q,BindTable) {
 Line 170  def tr_apply_function0(Q,BindTable) {
    }
    R = 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) {
 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?
-     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);
    Node = qt_node(F);
    if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {
-Line 291  def qt_dependent(F,X) {
+Line 293  def qt_dependent(F,X) {
 Line 291  def qt_dependent(F,X) {
 Line 293  def qt_dependent(F,X) {
       N = qt_nchild(F);
       for (I=0; I<N;I++) {
         C = qt_child(F,I);
-        if (qt_dependent(C,X)) return 1;
+        if (qt_is_dependent(C,X)) return 1;
       }
       return 0;
    }
-Line 342  def qt_map_arg(F,Q) {
+Line 344  def qt_map_arg(F,Q) {
 Line 342  def qt_map_arg(F,Q) {
 Line 344  def qt_map_arg(F,Q) {
    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
  */
+ 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$

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