===================================================================
RCS file: /home/cvs/OpenXM/src/asir-contrib/testing/test1-tr.rr,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- OpenXM/src/asir-contrib/testing/test1-tr.rr	2005/04/02 05:56:57	1.2
+++ OpenXM/src/asir-contrib/testing/test1-tr.rr	2005/04/03 11:05:21	1.3
@@ -1,5 +1,5 @@
-/* $OpenXM$ */
-/* $Id: test1-tr.rr,v 1.2 2005/04/02 05:56:57 takayama Exp $ */
+/* $OpenXM: OpenXM/src/asir-contrib/testing/test1-tr.rr,v 1.2 2005/04/02 05:56:57 takayama Exp $ */
+/* $Id: test1-tr.rr,v 1.3 2005/04/03 11:05:21 takayama Exp $ */
 
 load("tr.rr")$
 
@@ -99,6 +99,87 @@ 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;
 }