62 |
62 |
63 (** search criterion filters **) |
63 (** search criterion filters **) |
64 |
64 |
65 (*generated filters are to be of the form |
65 (*generated filters are to be of the form |
66 input: (PureThy.thmref * Thm.thm) |
66 input: (PureThy.thmref * Thm.thm) |
67 output: (p::int, s::int) option, where |
67 output: (p:int, s:int) option, where |
68 NONE indicates no match |
68 NONE indicates no match |
69 p is the primary sorting criterion |
69 p is the primary sorting criterion |
70 (eg. number of assumptions in the theorem) |
70 (eg. number of assumptions in the theorem) |
71 s is the secondary sorting criterion |
71 s is the secondary sorting criterion |
72 (eg. size of the substitution for intro, elim and dest) |
72 (eg. size of the substitution for intro, elim and dest) |
73 when applying a set of filters to a thm, fold results in: |
73 when applying a set of filters to a thm, fold results in: |
74 (biggest p, sum of all s) |
74 (biggest p, sum of all s) |
75 currently p and s only matter for intro, elim, dest and simp filters, |
75 currently p and s only matter for intro, elim, dest and simp filters, |
76 otherwise the default ordering ("by package") is used. |
76 otherwise the default ordering is used. |
77 *) |
77 *) |
78 |
78 |
79 |
79 |
80 (* matching theorems *) |
80 (* matching theorems *) |
81 |
81 |
82 fun is_nontrivial sg = is_Const o head_of o ObjectLogic.drop_judgment sg; |
82 fun is_nontrivial thy = is_Const o head_of o ObjectLogic.drop_judgment thy; |
83 |
83 |
84 (*extract terms from term_src, refine them to the parts that concern us, |
84 (*extract terms from term_src, refine them to the parts that concern us, |
85 if po try match them against obj else vice versa. |
85 if po try match them against obj else vice versa. |
86 trivial matches are ignored. |
86 trivial matches are ignored. |
87 returns: smallest substitution size*) |
87 returns: smallest substitution size*) |
88 fun is_matching_thm (extract_terms, refine_term) ctxt po obj term_src = |
88 fun is_matching_thm (extract_terms, refine_term) ctxt po obj term_src = |
89 let |
89 let |
90 val sg = ProofContext.sign_of ctxt; |
90 val thy = ProofContext.theory_of ctxt; |
91 val tsig = Sign.tsig_of sg; |
91 val tsig = Sign.tsig_of thy; |
92 |
92 |
93 fun matches pat = |
93 fun matches pat = |
94 is_nontrivial sg pat andalso |
94 is_nontrivial thy pat andalso |
95 Pattern.matches tsig (if po then (pat,obj) else (obj,pat)); |
95 Pattern.matches tsig (if po then (pat,obj) else (obj,pat)); |
96 |
96 |
97 fun substsize pat = |
97 fun substsize pat = |
98 let |
98 let |
99 val (_,subst) = Pattern.match tsig (if po then (pat,obj) else (obj,pat)) |
99 val (_,subst) = Pattern.match tsig (if po then (pat,obj) else (obj,pat)) |
100 in Vartab.foldl (op + o apsnd (size_of_term o snd o snd)) (0, subst) |
100 in Vartab.foldl (op + o apsnd (size_of_term o snd o snd)) (0, subst) |
101 end; |
101 end; |
102 |
102 |
103 fun bestmatch [] = NONE |
103 fun bestmatch [] = NONE |
104 | bestmatch (x :: xs) = SOME (foldl Int.min x xs); |
104 | bestmatch (x :: xs) = SOME (foldl Int.min x xs); |
105 |
105 |
106 val match_thm = matches o refine_term; |
106 val match_thm = matches o refine_term; |
107 in |
107 in |
108 map (substsize o refine_term) |
108 map (substsize o refine_term) |
109 (List.filter match_thm (extract_terms term_src)) |> bestmatch |
109 (List.filter match_thm (extract_terms term_src)) |> bestmatch |
110 end; |
110 end; |
111 |
111 |
112 |
112 |
113 (* filter_name *) |
113 (* filter_name *) |
118 else if String.substring (str, 0, String.size pat) = pat then true |
118 else if String.substring (str, 0, String.size pat) = pat then true |
119 else is_substring pat (String.extract (str, 1, NONE)); |
119 else is_substring pat (String.extract (str, 1, NONE)); |
120 |
120 |
121 (*filter that just looks for a string in the name, |
121 (*filter that just looks for a string in the name, |
122 substring match only (no regexps are performed)*) |
122 substring match only (no regexps are performed)*) |
123 fun filter_name str_pat (thmref, _) = |
123 fun filter_name str_pat (thmref, _) = |
124 if is_substring str_pat (PureThy.name_of_thmref thmref) |
124 if is_substring str_pat (PureThy.name_of_thmref thmref) |
125 then SOME (0,0) else NONE; |
125 then SOME (0,0) else NONE; |
126 |
126 |
127 |
127 |
128 (* filter intro/elim/dest rules *) |
128 (* filter intro/elim/dest rules *) |
129 |
129 |
133 (fn thm => if Thm.no_prems thm then [] else [prop_of thm], |
133 (fn thm => if Thm.no_prems thm then [] else [prop_of thm], |
134 hd o Logic.strip_imp_prems); |
134 hd o Logic.strip_imp_prems); |
135 val prems = Logic.prems_of_goal goal 1; |
135 val prems = Logic.prems_of_goal goal 1; |
136 |
136 |
137 fun try_subst prem = is_matching_thm extract_dest ctxt true prem thm; |
137 fun try_subst prem = is_matching_thm extract_dest ctxt true prem thm; |
138 |
138 |
139 (*keep successful substitutions*) |
139 (*keep successful substitutions*) |
140 val ss = prems |> List.map try_subst |
140 val ss = prems |> List.map try_subst |
141 |> List.filter isSome |
141 |> List.filter isSome |
142 |> List.map valOf; |
142 |> List.map valOf; |
143 in |
143 in |
144 (*if possible, keep best substitution (one with smallest size)*) |
144 (*if possible, keep best substitution (one with smallest size)*) |
145 (*dest rules always have assumptions, so a dest with one |
145 (*dest rules always have assumptions, so a dest with one |
146 assumption is as good as an intro rule with none*) |
146 assumption is as good as an intro rule with none*) |
147 if not (null ss) |
147 if not (null ss) |
148 then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE |
148 then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE |
149 end; |
149 end; |
150 |
150 |
151 fun filter_intro ctxt goal (_,thm) = |
151 fun filter_intro ctxt goal (_,thm) = |
152 let |
152 let |
166 val rule_mp = (hd o Logic.strip_imp_prems) rule; |
166 val rule_mp = (hd o Logic.strip_imp_prems) rule; |
167 val rule_concl = Logic.strip_imp_concl rule; |
167 val rule_concl = Logic.strip_imp_concl rule; |
168 fun combine t1 t2 = Const ("combine", dummyT --> dummyT) $ (t1 $ t2); |
168 fun combine t1 t2 = Const ("combine", dummyT --> dummyT) $ (t1 $ t2); |
169 val rule_tree = combine rule_mp rule_concl; |
169 val rule_tree = combine rule_mp rule_concl; |
170 fun goal_tree prem = (combine prem goal_concl); |
170 fun goal_tree prem = (combine prem goal_concl); |
171 fun try_subst prem = |
171 fun try_subst prem = |
172 is_matching_thm (single, I) ctxt true (goal_tree prem) rule_tree; |
172 is_matching_thm (single, I) ctxt true (goal_tree prem) rule_tree; |
173 (*keep successful substitutions*) |
173 (*keep successful substitutions*) |
174 val ss = prems |> List.map try_subst |
174 val ss = prems |> List.map try_subst |
175 |> List.filter isSome |
175 |> List.filter isSome |
176 |> List.map valOf; |
176 |> List.map valOf; |
177 in |
177 in |
178 (*elim rules always have assumptions, so an elim with one |
178 (*elim rules always have assumptions, so an elim with one |
179 assumption is as good as an intro rule with none*) |
179 assumption is as good as an intro rule with none*) |
180 if is_nontrivial (ProofContext.sign_of ctxt) (Thm.major_prem_of thm) |
180 if is_nontrivial (ProofContext.theory_of ctxt) (Thm.major_prem_of thm) |
181 andalso not (null ss) |
181 andalso not (null ss) |
182 then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE |
182 then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE |
183 end |
183 end |
184 else NONE |
184 else NONE |
185 |
185 |
188 |
188 |
189 fun filter_simp ctxt t (_,thm) = |
189 fun filter_simp ctxt t (_,thm) = |
190 let |
190 let |
191 val (_, {mk_rews = {mk, ...}, ...}) = |
191 val (_, {mk_rews = {mk, ...}, ...}) = |
192 MetaSimplifier.rep_ss (Simplifier.local_simpset_of ctxt); |
192 MetaSimplifier.rep_ss (Simplifier.local_simpset_of ctxt); |
193 val extract_simp = |
193 val extract_simp = |
194 ((List.map prop_of) o mk, #1 o Logic.dest_equals o Logic.strip_imp_concl); |
194 ((List.map prop_of) o mk, #1 o Logic.dest_equals o Logic.strip_imp_concl); |
195 val ss = is_matching_thm extract_simp ctxt false t thm |
195 val ss = is_matching_thm extract_simp ctxt false t thm |
196 in |
196 in |
197 if is_some ss then SOME (nprems_of thm, valOf ss) else NONE |
197 if is_some ss then SOME (nprems_of thm, valOf ss) else NONE |
198 end; |
198 end; |
199 |
199 |
200 |
200 |
201 (* filter_pattern *) |
201 (* filter_pattern *) |
202 |
202 |
203 fun filter_pattern ctxt pat (_, thm) = |
203 fun filter_pattern ctxt pat (_, thm) = |
204 let val tsig = Sign.tsig_of (ProofContext.sign_of ctxt) |
204 let val tsig = Sign.tsig_of (ProofContext.theory_of ctxt) |
205 in if Pattern.matches_subterm tsig (pat, Thm.prop_of thm) then SOME (0,0) |
205 in if Pattern.matches_subterm tsig (pat, Thm.prop_of thm) then SOME (0,0) |
206 else NONE end; |
206 else NONE end; |
207 |
207 |
208 (* interpret criteria as filters *) |
208 (* interpret criteria as filters *) |
209 |
209 |
210 local |
210 local |