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

Return to test1-tr.rr CVS log

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

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

-version 1.2, 2005/04/02 05:56:57
+version 1.4, 2005/04/06 09:26:28
 Line 1
 Line 1
 Line 1
- /* $OpenXM$ */
+ /* $OpenXM: OpenXM/src/asir-contrib/testing/test1-tr.rr,v 1.3 2005/04/03 11:05:21 takayama Exp $ */
  /* $Id$ */
  load("tr.rr")$
 Line 99  def test3a(R0)  {
 Line 99  def test3a(R0)  {
 Line 99  def test3a(R0)  {
        R=tr_apply_rule1(R,Rules[I][0],Rules[I][1]);
      }
    }
+   return R;
+ }
+ /* 関数のマッチ.  N[] 相当.  test4(). */
+ /*  quote(nn(pn(f),qt_is_function(f))); は不要. qt_map_arg が処理 */
+ def test4() {
+   Rule=[quote(nn(pn(f))),[qt_map_arg,nn,f]];
+   R0 = quote(nn(sin(1/2)*cos(1/3)));
+   print(print_input_form(R0));
+   R=tr_apply_rule1(R0,Rule[0],Rule[1]);
+   return R;
+ }
+ /* tr_apply_or_rule の試作 */
+ /* Flag 付き の tr_rp. 属性がないのでこれでやる. */
+ def tr_rp_flag(F,P,Q) {
+   Flag = 0;
+   dprint0("tr_rp, F="); dprint(F);
+   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 (type(F) != 4) return F;
+   Node = qt_node(F);
+   N = qt_nchild(F);
+   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]]);
+   }
+   return [Flag,Ans];
+ }
+ /* 書き換え flag 付きの tr_apply_rule_flag */
+ def tr_apply_rule1_flag(Obj,L,R) {
+   Flag = 0;
+   dprint("--------  start of tr_apply_rule1_flag ------------ ");
+   Obj = quotetolist(Obj);
+   L = quotetolist(L);
+   R = tr_rp_flag(Obj,L,R);
+   Flag=R[0]; R=R[1];
+   if (type(R) == 17) R=quotetolist(R);
+   RR = "quote("+listtoquote_str(R)+")";
+   dprint("--------  end of tr_apply_rule1_flag ------------ ");
+   return [Flag,eval_str(RR)];
+ }
+ def tr_apply_or_rules(Q,R) {
+   Flag = 1;
+   N = length(R);
+   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;
+ }
+ def test5() {
+   Rule1=[quote(sin(pn(x)*@pi)),[qt_sin_int,x]]; /* sin(整数*@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 */
+   R0 = quote(1+sin(sin(2*@pi)*sin(@pi/2))+sin(5*@pi));
+   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]);
    return R;
  }

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