diff -r f48b8a82c1e3 -r 4335435fcf83 Quot/QuotMain.thy --- 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 ? \ id *) (* 2: does ? \ 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 "\A; A \ B; QUOT_TRUE D \ B = C; C = D\ \ D" by (simp add: QUOT_TRUE_def)} +val lifting_procedure = + @{lemma "\A; A \ B; QUOT_TRUE D \ B = C; C = D\ \ D" by (simp add: QUOT_TRUE_def)} *} ML {*