author | wenzelm |
Fri, 03 Jul 2015 14:41:55 +0200 | |
changeset 60639 | 6686a410842a |
parent 60327 | a3f565b8ba76 |
child 60642 | 48dd1cefb4ae |
permissions | -rw-r--r-- |
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29064
diff
changeset
|
1 |
(* Title: HOL/Statespace/distinct_tree_prover.ML |
25171 | 2 |
Author: Norbert Schirmer, TU Muenchen |
3 |
*) |
|
4 |
||
25408 | 5 |
signature DISTINCT_TREE_PROVER = |
6 |
sig |
|
45355 | 7 |
datatype direction = Left | Right |
29302 | 8 |
val mk_tree : ('a -> term) -> typ -> 'a list -> term |
9 |
val dest_tree : term -> term list |
|
45355 | 10 |
val find_tree : term -> term -> direction list option |
25408 | 11 |
|
29302 | 12 |
val neq_to_eq_False : thm |
60327 | 13 |
val distinctTreeProver : Proof.context -> thm -> direction list -> direction list -> thm |
45355 | 14 |
val neq_x_y : Proof.context -> term -> term -> string -> thm option |
29302 | 15 |
val distinctFieldSolver : string list -> solver |
42368
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
16 |
val distinctTree_tac : string list -> Proof.context -> int -> tactic |
60327 | 17 |
val distinct_implProver : Proof.context -> thm -> cterm -> thm |
18 |
val subtractProver : Proof.context -> term -> cterm -> thm -> thm |
|
29302 | 19 |
val distinct_simproc : string list -> simproc |
45355 | 20 |
|
60639 | 21 |
val discharge : Proof.context -> thm list -> thm -> thm |
25408 | 22 |
end; |
23 |
||
24 |
structure DistinctTreeProver : DISTINCT_TREE_PROVER = |
|
25171 | 25 |
struct |
39159 | 26 |
|
45356 | 27 |
val neq_to_eq_False = @{thm neq_to_eq_False}; |
25171 | 28 |
|
45355 | 29 |
datatype direction = Left | Right; |
25408 | 30 |
|
45355 | 31 |
fun treeT T = Type (@{type_name tree}, [T]); |
45740 | 32 |
|
45355 | 33 |
fun mk_tree' e T n [] = Const (@{const_name Tip}, treeT T) |
25171 | 34 |
| mk_tree' e T n xs = |
35 |
let |
|
36 |
val m = (n - 1) div 2; |
|
37 |
val (xsl,x::xsr) = chop m xs; |
|
38 |
val l = mk_tree' e T m xsl; |
|
39 |
val r = mk_tree' e T (n-(m+1)) xsr; |
|
45355 | 40 |
in |
41 |
Const (@{const_name Node}, treeT T --> T --> HOLogic.boolT--> treeT T --> treeT T) $ |
|
45740 | 42 |
l $ e x $ @{term False} $ r |
25171 | 43 |
end |
44 |
||
45355 | 45 |
fun mk_tree e T xs = mk_tree' e T (length xs) xs; |
25171 | 46 |
|
45355 | 47 |
fun dest_tree (Const (@{const_name Tip}, _)) = [] |
48 |
| dest_tree (Const (@{const_name Node}, _) $ l $ e $ _ $ r) = dest_tree l @ e :: dest_tree r |
|
49 |
| dest_tree t = raise TERM ("dest_tree", [t]); |
|
25171 | 50 |
|
25408 | 51 |
|
25171 | 52 |
|
45355 | 53 |
fun lin_find_tree e (Const (@{const_name Tip}, _)) = NONE |
54 |
| lin_find_tree e (Const (@{const_name Node}, _) $ l $ x $ _ $ r) = |
|
55 |
if e aconv x |
|
25171 | 56 |
then SOME [] |
45355 | 57 |
else |
58 |
(case lin_find_tree e l of |
|
59 |
SOME path => SOME (Left :: path) |
|
60 |
| NONE => |
|
61 |
(case lin_find_tree e r of |
|
62 |
SOME path => SOME (Right :: path) |
|
63 |
| NONE => NONE)) |
|
64 |
| lin_find_tree e t = raise TERM ("find_tree: input not a tree", [t]) |
|
25171 | 65 |
|
45355 | 66 |
fun bin_find_tree order e (Const (@{const_name Tip}, _)) = NONE |
67 |
| bin_find_tree order e (Const (@{const_name Node}, _) $ l $ x $ _ $ r) = |
|
68 |
(case order (e, x) of |
|
69 |
EQUAL => SOME [] |
|
70 |
| LESS => Option.map (cons Left) (bin_find_tree order e l) |
|
71 |
| GREATER => Option.map (cons Right) (bin_find_tree order e r)) |
|
72 |
| bin_find_tree order e t = raise TERM ("find_tree: input not a tree", [t]) |
|
25171 | 73 |
|
74 |
fun find_tree e t = |
|
35408 | 75 |
(case bin_find_tree Term_Ord.fast_term_ord e t of |
45355 | 76 |
NONE => lin_find_tree e t |
77 |
| x => x); |
|
78 |
||
25171 | 79 |
|
45355 | 80 |
fun split_common_prefix xs [] = ([], xs, []) |
81 |
| split_common_prefix [] ys = ([], [], ys) |
|
82 |
| split_common_prefix (xs as (x :: xs')) (ys as (y :: ys')) = |
|
83 |
if x = y |
|
84 |
then let val (ps, xs'', ys'') = split_common_prefix xs' ys' in (x :: ps, xs'', ys'') end |
|
85 |
else ([], xs, ys) |
|
25171 | 86 |
|
87 |
||
88 |
(* Wrapper around Thm.instantiate. The type instiations of instTs are applied to |
|
89 |
* the right hand sides of insts |
|
90 |
*) |
|
60327 | 91 |
fun instantiate ctxt instTs insts = |
25171 | 92 |
let |
59582 | 93 |
val instTs' = map (fn (T, U) => (dest_TVar (Thm.typ_of T), Thm.typ_of U)) instTs; |
25171 | 94 |
fun substT x = (case AList.lookup (op =) instTs' x of NONE => TVar x | SOME T' => T'); |
95 |
fun mapT_and_recertify ct = |
|
60327 | 96 |
(Thm.cterm_of ctxt (Term.map_types (Term.map_type_tvar substT) (Thm.term_of ct))); |
25171 | 97 |
val insts' = map (apfst mapT_and_recertify) insts; |
45355 | 98 |
in Thm.instantiate (instTs, insts') end; |
25171 | 99 |
|
51701
1e29891759c4
tuned exceptions -- avoid composing error messages in low-level situations;
wenzelm
parents:
45740
diff
changeset
|
100 |
fun tvar_clash ixn S S' = |
1e29891759c4
tuned exceptions -- avoid composing error messages in low-level situations;
wenzelm
parents:
45740
diff
changeset
|
101 |
raise TYPE ("Type variable has two distinct sorts", [TVar (ixn, S), TVar (ixn, S')], []); |
25171 | 102 |
|
103 |
fun lookup (tye, (ixn, S)) = |
|
104 |
(case AList.lookup (op =) tye ixn of |
|
105 |
NONE => NONE |
|
106 |
| SOME (S', T) => if S = S' then SOME T else tvar_clash ixn S S'); |
|
107 |
||
108 |
val naive_typ_match = |
|
109 |
let |
|
110 |
fun match (TVar (v, S), T) subs = |
|
111 |
(case lookup (subs, (v, S)) of |
|
112 |
NONE => ((v, (S, T))::subs) |
|
113 |
| SOME _ => subs) |
|
114 |
| match (Type (a, Ts), Type (b, Us)) subs = |
|
115 |
if a <> b then raise Type.TYPE_MATCH |
|
116 |
else matches (Ts, Us) subs |
|
117 |
| match (TFree x, TFree y) subs = |
|
118 |
if x = y then subs else raise Type.TYPE_MATCH |
|
119 |
| match _ _ = raise Type.TYPE_MATCH |
|
120 |
and matches (T :: Ts, U :: Us) subs = matches (Ts, Us) (match (T, U) subs) |
|
121 |
| matches _ subs = subs; |
|
122 |
in match end; |
|
123 |
||
124 |
||
45355 | 125 |
(* expects that relevant type variables are already contained in |
25171 | 126 |
* term variables. First instantiation of variables is returned without further |
127 |
* checking. |
|
128 |
*) |
|
45355 | 129 |
fun naive_cterm_first_order_match (t, ct) env = |
25171 | 130 |
let |
45355 | 131 |
fun mtch (env as (tyinsts, insts)) = |
132 |
fn (Var (ixn, T), ct) => |
|
133 |
(case AList.lookup (op =) insts ixn of |
|
59586 | 134 |
NONE => (naive_typ_match (T, Thm.typ_of_cterm ct) tyinsts, (ixn, ct) :: insts) |
45355 | 135 |
| SOME _ => env) |
136 |
| (f $ t, ct) => |
|
137 |
let val (cf, ct') = Thm.dest_comb ct; |
|
138 |
in mtch (mtch env (f, cf)) (t, ct') end |
|
139 |
| _ => env; |
|
140 |
in mtch env (t, ct) end; |
|
25171 | 141 |
|
142 |
||
60639 | 143 |
fun discharge ctxt prems rule = |
25171 | 144 |
let |
45355 | 145 |
val (tyinsts,insts) = |
59582 | 146 |
fold naive_cterm_first_order_match (Thm.prems_of rule ~~ map Thm.cprop_of prems) ([], []); |
45355 | 147 |
val tyinsts' = |
60639 | 148 |
map (fn (v, (S, U)) => apply2 (Thm.ctyp_of ctxt) (TVar (v, S), U)) tyinsts; |
45355 | 149 |
val insts' = |
60639 | 150 |
map (fn (idxn, ct) => (Thm.cterm_of ctxt (Var (idxn, Thm.typ_of_cterm ct)), ct)) insts; |
45355 | 151 |
val rule' = Thm.instantiate (tyinsts', insts') rule; |
152 |
in fold Thm.elim_implies prems rule' end; |
|
25171 | 153 |
|
154 |
local |
|
155 |
||
45355 | 156 |
val (l_in_set_root, x_in_set_root, r_in_set_root) = |
157 |
let |
|
158 |
val (Node_l_x_d, r) = |
|
59582 | 159 |
Thm.cprop_of @{thm in_set_root} |
45355 | 160 |
|> Thm.dest_comb |> #2 |
161 |
|> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2 |> Thm.dest_comb; |
|
162 |
val (Node_l, x) = Node_l_x_d |> Thm.dest_comb |> #1 |> Thm.dest_comb; |
|
163 |
val l = Node_l |> Thm.dest_comb |> #2; |
|
164 |
in (l,x,r) end; |
|
25171 | 165 |
|
45355 | 166 |
val (x_in_set_left, r_in_set_left) = |
167 |
let |
|
168 |
val (Node_l_x_d, r) = |
|
59582 | 169 |
Thm.cprop_of @{thm in_set_left} |
45355 | 170 |
|> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2 |
171 |
|> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2 |> Thm.dest_comb; |
|
172 |
val x = Node_l_x_d |> Thm.dest_comb |> #1 |> Thm.dest_comb |> #2; |
|
173 |
in (x, r) end; |
|
174 |
||
175 |
val (x_in_set_right, l_in_set_right) = |
|
176 |
let |
|
177 |
val (Node_l, x) = |
|
59582 | 178 |
Thm.cprop_of @{thm in_set_right} |
45355 | 179 |
|> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2 |
180 |
|> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2 |
|
181 |
|> Thm.dest_comb |> #1 |> Thm.dest_comb |> #1 |
|
182 |
|> Thm.dest_comb; |
|
183 |
val l = Node_l |> Thm.dest_comb |> #2; |
|
184 |
in (x, l) end; |
|
25171 | 185 |
|
186 |
in |
|
187 |
(* |
|
188 |
1. First get paths x_path y_path of x and y in the tree. |
|
189 |
2. For the common prefix descend into the tree according to the path |
|
190 |
and lemmas all_distinct_left/right |
|
191 |
3. If one restpath is empty use distinct_left/right, |
|
192 |
otherwise all_distinct_left_right |
|
193 |
*) |
|
194 |
||
60327 | 195 |
fun distinctTreeProver ctxt dist_thm x_path y_path = |
25171 | 196 |
let |
197 |
fun dist_subtree [] thm = thm |
|
45355 | 198 |
| dist_subtree (p :: ps) thm = |
199 |
let |
|
45356 | 200 |
val rule = |
201 |
(case p of Left => @{thm all_distinct_left} | Right => @{thm all_distinct_right}) |
|
60639 | 202 |
in dist_subtree ps (discharge ctxt [thm] rule) end; |
25171 | 203 |
|
45355 | 204 |
val (ps, x_rest, y_rest) = split_common_prefix x_path y_path; |
25171 | 205 |
val dist_subtree_thm = dist_subtree ps dist_thm; |
59582 | 206 |
val subtree = Thm.cprop_of dist_subtree_thm |> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2; |
45355 | 207 |
val (_, [l, _, _, r]) = Drule.strip_comb subtree; |
208 |
||
25171 | 209 |
fun in_set ps tree = |
210 |
let |
|
45355 | 211 |
val (_, [l, x, _, r]) = Drule.strip_comb tree; |
59586 | 212 |
val xT = Thm.ctyp_of_cterm x; |
45355 | 213 |
in |
214 |
(case ps of |
|
215 |
[] => |
|
60327 | 216 |
instantiate ctxt |
59586 | 217 |
[(Thm.ctyp_of_cterm x_in_set_root, xT)] |
45356 | 218 |
[(l_in_set_root, l), (x_in_set_root, x), (r_in_set_root, r)] @{thm in_set_root} |
45355 | 219 |
| Left :: ps' => |
220 |
let |
|
221 |
val in_set_l = in_set ps' l; |
|
222 |
val in_set_left' = |
|
60327 | 223 |
instantiate ctxt |
59586 | 224 |
[(Thm.ctyp_of_cterm x_in_set_left, xT)] |
45356 | 225 |
[(x_in_set_left, x), (r_in_set_left, r)] @{thm in_set_left}; |
60639 | 226 |
in discharge ctxt [in_set_l] in_set_left' end |
45355 | 227 |
| Right :: ps' => |
228 |
let |
|
229 |
val in_set_r = in_set ps' r; |
|
230 |
val in_set_right' = |
|
60327 | 231 |
instantiate ctxt |
59586 | 232 |
[(Thm.ctyp_of_cterm x_in_set_right, xT)] |
45356 | 233 |
[(x_in_set_right, x), (l_in_set_right, l)] @{thm in_set_right}; |
60639 | 234 |
in discharge ctxt [in_set_r] in_set_right' end) |
45355 | 235 |
end; |
25171 | 236 |
|
45355 | 237 |
fun in_set' [] = raise TERM ("distinctTreeProver", []) |
238 |
| in_set' (Left :: ps) = in_set ps l |
|
239 |
| in_set' (Right :: ps) = in_set ps r; |
|
240 |
||
60639 | 241 |
fun distinct_lr node_in_set Left = |
242 |
discharge ctxt [dist_subtree_thm, node_in_set] @{thm distinct_left} |
|
243 |
| distinct_lr node_in_set Right = |
|
244 |
discharge ctxt [dist_subtree_thm, node_in_set] @{thm distinct_right} |
|
25171 | 245 |
|
45355 | 246 |
val (swap, neq) = |
247 |
(case x_rest of |
|
248 |
[] => |
|
249 |
let val y_in_set = in_set' y_rest; |
|
250 |
in (false, distinct_lr y_in_set (hd y_rest)) end |
|
251 |
| xr :: xrs => |
|
252 |
(case y_rest of |
|
253 |
[] => |
|
254 |
let val x_in_set = in_set' x_rest; |
|
255 |
in (true, distinct_lr x_in_set (hd x_rest)) end |
|
256 |
| yr :: yrs => |
|
257 |
let |
|
258 |
val x_in_set = in_set' x_rest; |
|
259 |
val y_in_set = in_set' y_rest; |
|
260 |
in |
|
261 |
(case xr of |
|
45356 | 262 |
Left => |
60639 | 263 |
(false, |
264 |
discharge ctxt [dist_subtree_thm, x_in_set, y_in_set] @{thm distinct_left_right}) |
|
45356 | 265 |
| Right => |
60639 | 266 |
(true, |
267 |
discharge ctxt [dist_subtree_thm, y_in_set, x_in_set] @{thm distinct_left_right})) |
|
45355 | 268 |
end)); |
60639 | 269 |
in if swap then discharge ctxt [neq] @{thm swap_neq} else neq end; |
25171 | 270 |
|
271 |
||
60639 | 272 |
fun deleteProver _ dist_thm [] = @{thm delete_root} OF [dist_thm] |
273 |
| deleteProver ctxt dist_thm (p::ps) = |
|
45355 | 274 |
let |
45356 | 275 |
val dist_rule = |
276 |
(case p of Left => @{thm all_distinct_left} | Right => @{thm all_distinct_right}); |
|
60639 | 277 |
val dist_thm' = discharge ctxt [dist_thm] dist_rule; |
45356 | 278 |
val del_rule = (case p of Left => @{thm delete_left} | Right => @{thm delete_right}); |
60639 | 279 |
val del = deleteProver ctxt dist_thm' ps; |
280 |
in discharge ctxt [dist_thm, del] del_rule end; |
|
25171 | 281 |
|
282 |
local |
|
45355 | 283 |
val (alpha, v) = |
25171 | 284 |
let |
45355 | 285 |
val ct = |
45356 | 286 |
@{thm subtract_Tip} |> Thm.cprop_of |> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2 |
45355 | 287 |
|> Thm.dest_comb |> #2; |
59586 | 288 |
val [alpha] = ct |> Thm.ctyp_of_cterm |> Thm.dest_ctyp; |
59582 | 289 |
in (alpha, #1 (dest_Var (Thm.term_of ct))) end; |
25171 | 290 |
in |
291 |
||
60327 | 292 |
fun subtractProver ctxt (Const (@{const_name Tip}, T)) ct dist_thm = |
45355 | 293 |
let |
294 |
val ct' = dist_thm |> Thm.cprop_of |> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2; |
|
295 |
val [alphaI] = #2 (dest_Type T); |
|
296 |
in |
|
297 |
Thm.instantiate |
|
60327 | 298 |
([(alpha, Thm.ctyp_of ctxt alphaI)], |
299 |
[(Thm.cterm_of ctxt (Var (v, treeT alphaI)), ct')]) @{thm subtract_Tip} |
|
45355 | 300 |
end |
60327 | 301 |
| subtractProver ctxt (Const (@{const_name Node}, nT) $ l $ x $ d $ r) ct dist_thm = |
45355 | 302 |
let |
303 |
val ct' = dist_thm |> Thm.cprop_of |> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2; |
|
304 |
val (_, [cl, _, _, cr]) = Drule.strip_comb ct; |
|
59582 | 305 |
val ps = the (find_tree x (Thm.term_of ct')); |
60639 | 306 |
val del_tree = deleteProver ctxt dist_thm ps; |
307 |
val dist_thm' = discharge ctxt [del_tree, dist_thm] @{thm delete_Some_all_distinct}; |
|
60327 | 308 |
val sub_l = subtractProver ctxt (Thm.term_of cl) cl (dist_thm'); |
45355 | 309 |
val sub_r = |
60327 | 310 |
subtractProver ctxt (Thm.term_of cr) cr |
60639 | 311 |
(discharge ctxt [sub_l, dist_thm'] @{thm subtract_Some_all_distinct_res}); |
312 |
in discharge ctxt [del_tree, sub_l, sub_r] @{thm subtract_Node} end; |
|
45355 | 313 |
|
314 |
end; |
|
315 |
||
60327 | 316 |
fun distinct_implProver ctxt dist_thm ct = |
25171 | 317 |
let |
318 |
val ctree = ct |> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2; |
|
60327 | 319 |
val sub = subtractProver ctxt (Thm.term_of ctree) ctree dist_thm; |
45356 | 320 |
in @{thm subtract_Some_all_distinct} OF [sub, dist_thm] end; |
25171 | 321 |
|
322 |
fun get_fst_success f [] = NONE |
|
45355 | 323 |
| get_fst_success f (x :: xs) = |
324 |
(case f x of |
|
325 |
NONE => get_fst_success f xs |
|
326 |
| SOME v => SOME v); |
|
25171 | 327 |
|
328 |
fun neq_x_y ctxt x y name = |
|
329 |
(let |
|
42361 | 330 |
val dist_thm = the (try (Proof_Context.get_thm ctxt) name); |
59582 | 331 |
val ctree = Thm.cprop_of dist_thm |> Thm.dest_comb |> #2 |> Thm.dest_comb |> #2; |
332 |
val tree = Thm.term_of ctree; |
|
25171 | 333 |
val x_path = the (find_tree x tree); |
334 |
val y_path = the (find_tree y tree); |
|
60327 | 335 |
val thm = distinctTreeProver ctxt dist_thm x_path y_path; |
45355 | 336 |
in SOME thm |
337 |
end handle Option.Option => NONE); |
|
25171 | 338 |
|
42368
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
339 |
fun distinctTree_tac names ctxt = SUBGOAL (fn (goal, i) => |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
340 |
(case goal of |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
341 |
Const (@{const_name Trueprop}, _) $ |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
342 |
(Const (@{const_name Not}, _) $ (Const (@{const_name HOL.eq}, _) $ x $ y)) => |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
343 |
(case get_fst_success (neq_x_y ctxt x y) names of |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
344 |
SOME neq => rtac neq i |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
345 |
| NONE => no_tac) |
3b8498ac2314
proper subgoal addressing via SUBGOAL/CSUBGOAL -- assuming these tactics did not handle Subscript in any special way;
wenzelm
parents:
42361
diff
changeset
|
346 |
| _ => no_tac)) |
25171 | 347 |
|
45355 | 348 |
fun distinctFieldSolver names = |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51701
diff
changeset
|
349 |
mk_solver "distinctFieldSolver" (distinctTree_tac names); |
25171 | 350 |
|
351 |
fun distinct_simproc names = |
|
38715
6513ea67d95d
renamed Simplifier.simproc(_i) to Simplifier.simproc_global(_i) to emphasize that this is not the real thing;
wenzelm
parents:
38558
diff
changeset
|
352 |
Simplifier.simproc_global @{theory HOL} "DistinctTreeProver.distinct_simproc" ["x = y"] |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51701
diff
changeset
|
353 |
(fn ctxt => |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51701
diff
changeset
|
354 |
(fn Const (@{const_name HOL.eq}, _) $ x $ y => |
45356 | 355 |
Option.map (fn neq => @{thm neq_to_eq_False} OF [neq]) |
45355 | 356 |
(get_fst_success (neq_x_y ctxt x y) names) |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51701
diff
changeset
|
357 |
| _ => NONE)); |
25171 | 358 |
|
45355 | 359 |
end; |
360 |
||
25171 | 361 |
end; |