--- a/Quot/QuotMain.thy Sat Dec 12 15:23:58 2009 +0100
+++ b/Quot/QuotMain.thy Sat Dec 12 16:40:29 2009 +0100
@@ -823,6 +823,7 @@
section {* Cleaning of the Theorem *}
ML {*
+(* expands all ---> except in front of bound variables *)
fun fun_map_simple_conv xs ctxt ctrm =
case (term_of ctrm) of
((Const (@{const_name "fun_map"}, _) $ _ $ _) $ h $ _) =>
@@ -844,34 +845,30 @@
(* Since the patterns for the lhs are different; there are 2 different make-insts *)
(* 1: does ? \<rightarrow> id *)
(* 2: does ? \<rightarrow> non-id *)
-ML {*
+ML {*
+fun mk_abs u i t =
+ if incr_boundvars i u aconv t then Bound i
+ else (case t of
+ t1 $ t2 => (mk_abs u i t1) $ (mk_abs u i t2)
+ | Abs (s, T, t') => Abs (s, T, mk_abs u (i + 1) t')
+ | Bound j => if i = j then error "make_inst" else t
+ | _ => t)
+
fun make_inst lhs t =
- let
- val _ $ (Abs (_, _, (f as Var (_, Type ("fun", [T, _]))) $ u)) = lhs;
- val _ $ (Abs (_, _, g)) = t;
- fun mk_abs i t =
- if incr_boundvars i u aconv t then Bound i
- else (case t of
- t1 $ t2 => mk_abs i t1 $ mk_abs i t2
- | Abs (s, T, t') => Abs (s, T, mk_abs (i + 1) t')
- | Bound j => if i = j then error "make_inst" else t
- | _ => t);
- in (f, Abs ("x", T, mk_abs 0 g)) end;
-*}
+let
+ val _ $ (Abs (_, _, (f as Var (_, Type ("fun", [T, _]))) $ u)) = lhs;
+ val _ $ (Abs (_, _, g)) = t;
+in
+ (f, Abs ("x", T, mk_abs u 0 g))
+end
-ML {*
fun make_inst2 lhs t =
- let
- val _ $ (Abs (_, _, (_ $ ((f as Var (_, Type ("fun", [T, _]))) $ u)))) = lhs;
- val _ $ (Abs (_, _, (_ $ g))) = t;
- fun mk_abs i t =
- if incr_boundvars i u aconv t then Bound i
- else (case t of
- t1 $ t2 => mk_abs i t1 $ mk_abs i t2
- | Abs (s, T, t') => Abs (s, T, mk_abs (i + 1) t')
- | Bound j => if i = j then error "make_inst" else t
- | _ => t);
- in (f, Abs ("x", T, mk_abs 0 g)) end;
+let
+ val _ $ (Abs (_, _, (_ $ ((f as Var (_, Type ("fun", [T, _]))) $ u)))) = lhs;
+ val _ $ (Abs (_, _, (_ $ g))) = t;
+in
+ (f, Abs ("x", T, mk_abs u 0 g))
+end
*}
ML {*
@@ -1005,8 +1002,8 @@
(* the QUOT_TRUE premise in 2 records the lifted theorem *)
ML {*
- val lifting_procedure =
- @{lemma "\<lbrakk>A; A \<longrightarrow> B; QUOT_TRUE D \<Longrightarrow> B = C; C = D\<rbrakk> \<Longrightarrow> D" by (simp add: QUOT_TRUE_def)}
+val lifting_procedure =
+ @{lemma "\<lbrakk>A; A \<longrightarrow> B; QUOT_TRUE D \<Longrightarrow> B = C; C = D\<rbrakk> \<Longrightarrow> D" by (simp add: QUOT_TRUE_def)}
*}
ML {*