| author | wenzelm | 
| Fri, 03 Nov 2000 21:29:56 +0100 | |
| changeset 10382 | 1fb807260ff1 | 
| parent 10265 | 4e004b548049 | 
| permissions | -rw-r--r-- | 
| 10265 | 1 | (* Title: HOL/UNITY/AllocBase.ML | 
| 8928 | 2 | ID: $Id$ | 
| 3 | Author: Lawrence C Paulson, Cambridge University Computer Laboratory | |
| 4 | Copyright 1998 University of Cambridge | |
| 5 | ||
| 6 | Basis declarations for Chandy and Charpentier's Allocator | |
| 7 | *) | |
| 8 | ||
| 9109 | 9 | Goal "!!f :: nat=>nat. \ | 
| 10 | \ (ALL i. i<n --> f i <= g i) --> \ | |
| 11 | \ setsum f (lessThan n) <= setsum g (lessThan n)"; | |
| 8928 | 12 | by (induct_tac "n" 1); | 
| 9109 | 13 | by (auto_tac (claset(), simpset() addsimps [lessThan_Suc])); | 
| 8928 | 14 | by (dres_inst_tac [("x","n")] spec 1);
 | 
| 15 | by (arith_tac 1); | |
| 9109 | 16 | qed_spec_mp "setsum_fun_mono"; | 
| 8928 | 17 | |
| 18 | Goal "ALL xs. xs <= ys --> tokens xs <= tokens ys"; | |
| 19 | by (induct_tac "ys" 1); | |
| 20 | by (auto_tac (claset(), simpset() addsimps [prefix_Cons])); | |
| 21 | qed_spec_mp "tokens_mono_prefix"; | |
| 22 | ||
| 23 | Goalw [mono_def] "mono tokens"; | |
| 24 | by (blast_tac (claset() addIs [tokens_mono_prefix]) 1); | |
| 25 | qed "mono_tokens"; | |
| 8989 | 26 | |
| 9026 | 27 | |
| 28 | (** bag_of **) | |
| 8989 | 29 | |
| 9026 | 30 | Goal "bag_of (l@l') = bag_of l + bag_of l'"; | 
| 31 | by (induct_tac "l" 1); | |
| 32 | by (asm_simp_tac (simpset() addsimps (thms "plus_ac0")) 2); | |
| 33 | by (Simp_tac 1); | |
| 34 | qed "bag_of_append"; | |
| 35 | Addsimps [bag_of_append]; | |
| 36 | ||
| 37 | Goal "mono (bag_of :: 'a list => ('a::order) multiset)";
 | |
| 38 | by (rtac monoI 1); | |
| 39 | by (rewtac prefix_def); | |
| 40 | by (etac genPrefix.induct 1); | |
| 41 | by Auto_tac; | |
| 10265 | 42 | by (asm_full_simp_tac (simpset() addsimps [thm "union_le_mono"]) 1); | 
| 9026 | 43 | by (etac order_trans 1); | 
| 10265 | 44 | by (rtac (thm "union_upper1") 1); | 
| 9026 | 45 | qed "mono_bag_of"; | 
| 46 | ||
| 9107 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 47 | (** setsum **) | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 48 | |
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 49 | Addcongs [setsum_cong]; | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 50 | |
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 51 | Goal "setsum (%i. {#if i<k then f i else g i#}) (A Int lessThan k) = \
 | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 52 | \     setsum (%i. {#f i#}) (A Int lessThan k)";
 | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 53 | by (rtac setsum_cong 1); | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 54 | by Auto_tac; | 
| 9026 | 55 | qed "bag_of_sublist_lemma"; | 
| 56 | ||
| 9107 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 57 | Goal "bag_of (sublist l A) = \ | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 58 | \     setsum (%i. {# l!i #}) (A Int lessThan (length l))";
 | 
| 9747 | 59 | by (rev_induct_tac "l" 1); | 
| 9026 | 60 | by (Simp_tac 1); | 
| 9107 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 61 | by (asm_simp_tac | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 62 | (simpset() addsimps [sublist_append, Int_insert_right, lessThan_Suc, | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 63 | nth_append, bag_of_sublist_lemma] @ thms "plus_ac0") 1); | 
| 9026 | 64 | qed "bag_of_sublist"; | 
| 65 | ||
| 9107 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 66 | |
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 67 | Goal "bag_of (sublist l (A Un B)) + bag_of (sublist l (A Int B)) = \ | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 68 | \ bag_of (sublist l A) + bag_of (sublist l B)"; | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 69 | by (subgoal_tac "A Int B Int {..length l(} = \
 | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 70 | \                (A Int {..length l(}) Int (B Int {..length l(})" 1);
 | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 71 | by (asm_simp_tac (simpset() addsimps [bag_of_sublist, Int_Un_distrib2, | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 72 | setsum_Un_Int]) 1); | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 73 | by (Blast_tac 1); | 
| 9026 | 74 | qed "bag_of_sublist_Un_Int"; | 
| 9107 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 75 | |
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 76 | Goal "A Int B = {} \
 | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 77 | \ ==> bag_of (sublist l (A Un B)) = \ | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 78 | \ bag_of (sublist l A) + bag_of (sublist l B)"; | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 79 | by (asm_simp_tac (simpset() addsimps [bag_of_sublist_Un_Int RS sym]) 1); | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 80 | qed "bag_of_sublist_Un_disjoint"; | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 81 | |
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 82 | Goal "[| finite I; ALL i:I. ALL j:I. i~=j --> A i Int A j = {} |] \
 | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 83 | \ ==> bag_of (sublist l (UNION I A)) = \ | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 84 | \ setsum (%i. bag_of (sublist l (A i))) I"; | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 85 | by (asm_simp_tac (simpset() delsimps UN_simps addsimps (UN_simps RL [sym]) | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 86 | addsimps [bag_of_sublist]) 1); | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 87 | by (stac setsum_UN_disjoint 1); | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 88 | by Auto_tac; | 
| 
67202a50ee6d
removed some finiteness conditions from bag_of/sublist theorems
 paulson parents: 
9090diff
changeset | 89 | qed_spec_mp "bag_of_sublist_UN_disjoint"; |