| author | nipkow | 
| Fri, 29 Nov 1996 15:07:27 +0100 | |
| changeset 2279 | 2f337bf81085 | 
| parent 2057 | 4d7a4b25a11f | 
| child 2897 | 27dc4862751b | 
| permissions | -rw-r--r-- | 
| 1278 | 1 | (* Title: HOL/Lambda/Commutation.thy | 
| 2 | ID: $Id$ | |
| 3 | Author: Tobias Nipkow | |
| 4 | Copyright 1995 TU Muenchen | |
| 5 | ||
| 6 | Basic commutation lemmas. | |
| 7 | *) | |
| 8 | ||
| 9 | open Commutation; | |
| 10 | ||
| 11 | (*** square ***) | |
| 12 | ||
| 13 | goalw Commutation.thy [square_def] "!!R. square R S T U ==> square S R U T"; | |
| 2031 | 14 | by (Fast_tac 1); | 
| 1278 | 15 | qed "square_sym"; | 
| 16 | ||
| 17 | goalw Commutation.thy [square_def] | |
| 1431 | 18 | "!!R. [| square R S T U; T <= T' |] ==> square R S T' U"; | 
| 2031 | 19 | by (Fast_tac 1); | 
| 1431 | 20 | qed "square_subset"; | 
| 21 | ||
| 22 | goalw Commutation.thy [square_def] | |
| 1278 | 23 | "!!R. [| square R S T (R^=); S <= T |] ==> square (R^=) S T (R^=)"; | 
| 2031 | 24 | by (Fast_tac 1); | 
| 1278 | 25 | qed "square_reflcl"; | 
| 26 | ||
| 27 | goalw Commutation.thy [square_def] | |
| 28 | "!!R. square R S S T ==> square (R^*) S S (T^*)"; | |
| 2031 | 29 | by (strip_tac 1); | 
| 1465 | 30 | by (etac rtrancl_induct 1); | 
| 2031 | 31 | by (Fast_tac 1); | 
| 32 | by (best_tac (!claset addSEs [rtrancl_into_rtrancl]) 1); | |
| 1278 | 33 | qed "square_rtrancl"; | 
| 34 | ||
| 35 | goalw Commutation.thy [commute_def] | |
| 36 | "!!R. square R S (S^*) (R^=) ==> commute (R^*) (S^*)"; | |
| 2031 | 37 | by (fast_tac (!claset addDs [square_reflcl,square_sym RS square_rtrancl] | 
| 1974 
b50f96543dec
Removed refs to clasets like rel_cs etc. Used implicit claset.
 nipkow parents: 
1641diff
changeset | 38 | addEs [r_into_rtrancl] | 
| 
b50f96543dec
Removed refs to clasets like rel_cs etc. Used implicit claset.
 nipkow parents: 
1641diff
changeset | 39 | addss !simpset) 1); | 
| 1278 | 40 | qed "square_rtrancl_reflcl_commute"; | 
| 41 | ||
| 42 | (*** commute ***) | |
| 43 | ||
| 44 | goalw Commutation.thy [commute_def] "!!R. commute R S ==> commute S R"; | |
| 2031 | 45 | by (fast_tac (!claset addIs [square_sym]) 1); | 
| 1278 | 46 | qed "commute_sym"; | 
| 47 | ||
| 48 | goalw Commutation.thy [commute_def] "!!R. commute R S ==> commute (R^*) (S^*)"; | |
| 2031 | 49 | by (fast_tac (!claset addIs [square_rtrancl,square_sym]) 1); | 
| 1278 | 50 | qed "commute_rtrancl"; | 
| 51 | ||
| 52 | goalw Commutation.thy [commute_def,square_def] | |
| 53 | "!!R. [| commute R T; commute S T |] ==> commute (R Un S) T"; | |
| 2031 | 54 | by (Fast_tac 1); | 
| 1278 | 55 | qed "commute_Un"; | 
| 56 | ||
| 57 | (*** diamond, confluence and union ***) | |
| 58 | ||
| 59 | goalw Commutation.thy [diamond_def] | |
| 60 | "!!R. [| diamond R; diamond S; commute R S |] ==> diamond (R Un S)"; | |
| 2031 | 61 | by (REPEAT(ares_tac [commute_Un,commute_sym] 1)); | 
| 1278 | 62 | qed "diamond_Un"; | 
| 63 | ||
| 64 | goalw Commutation.thy [diamond_def] "!!R. diamond R ==> confluent (R)"; | |
| 1465 | 65 | by (etac commute_rtrancl 1); | 
| 1278 | 66 | qed "diamond_confluent"; | 
| 67 | ||
| 1431 | 68 | goalw Commutation.thy [diamond_def] | 
| 69 | "!!R. square R R (R^=) (R^=) ==> confluent R"; | |
| 2031 | 70 | by (fast_tac (!claset addIs [square_rtrancl_reflcl_commute,r_into_rtrancl] | 
| 1431 | 71 | addEs [square_subset]) 1); | 
| 72 | qed "square_reflcl_confluent"; | |
| 73 | ||
| 1278 | 74 | goal Commutation.thy | 
| 75 | "!!R. [| confluent R; confluent S; commute (R^*) (S^*) |] \ | |
| 76 | \ ==> confluent(R Un S)"; | |
| 2031 | 77 | by (rtac (rtrancl_Un_rtrancl RS subst) 1); | 
| 1974 
b50f96543dec
Removed refs to clasets like rel_cs etc. Used implicit claset.
 nipkow parents: 
1641diff
changeset | 78 | by (fast_tac (!claset addDs [diamond_Un] addIs [diamond_confluent]) 1); | 
| 1278 | 79 | qed "confluent_Un"; | 
| 80 | ||
| 81 | goal Commutation.thy | |
| 82 | "!!R.[| diamond(R); T <= R; R <= T^* |] ==> confluent(T)"; | |
| 2031 | 83 | by (fast_tac (!claset addIs [diamond_confluent] | 
| 1974 
b50f96543dec
Removed refs to clasets like rel_cs etc. Used implicit claset.
 nipkow parents: 
1641diff
changeset | 84 | addDs [rtrancl_subset RS sym] addss !simpset) 1); | 
| 1278 | 85 | qed "diamond_to_confluence"; | 
| 86 | ||
| 87 | (*** Church_Rosser ***) | |
| 88 | ||
| 89 | goalw Commutation.thy [square_def,commute_def,diamond_def,Church_Rosser_def] | |
| 90 | "Church_Rosser(R) = confluent(R)"; | |
| 1465 | 91 | by (rtac iffI 1); | 
| 2057 | 92 | by (fast_tac (HOL_cs addIs | 
| 1278 | 93 | [Un_upper2 RS rtrancl_mono RS subsetD RS rtrancl_trans, | 
| 94 | rtrancl_converseI, converseI, Un_upper1 RS rtrancl_mono RS subsetD])1); | |
| 2031 | 95 | by (safe_tac HOL_cs); | 
| 1465 | 96 | by (etac rtrancl_induct 1); | 
| 2057 | 97 | by (Fast_tac 1); | 
| 2031 | 98 | by (slow_best_tac (!claset addIs [r_into_rtrancl] | 
| 1302 | 99 | addEs [rtrancl_trans,r_into_rtrancl RS rtrancl_trans]) 1); | 
| 1278 | 100 | qed "Church_Rosser_confluent"; |