Forgot to save, second part of the commit
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Wed, 14 Oct 2009 16:23:49 +0200
changeset 94 ecfc2e1fd15e
parent 93 ec29be471518
child 95 8c3a35da4560
Forgot to save, second part of the commit
QuotMain.thy
--- a/QuotMain.thy	Wed Oct 14 16:23:32 2009 +0200
+++ b/QuotMain.thy	Wed Oct 14 16:23:49 2009 +0200
@@ -394,6 +394,13 @@
       in
         Const(@{const_name "All"}, at) $ lam_term
       end
+  | ((Const (@{const_name "All"}, at)) $ P) =>
+      let
+        val (_, [al, _]) = dest_Type (fastype_of P);
+        val ([x], lthy2) = Variable.variant_fixes [""] lthy;
+        val v = (Free (x, al));
+        val abs = Term.lambda_name (x, v) (P $ v);
+      in regularise ((Const (@{const_name "All"}, at)) $ abs) rty rel lthy2 end
   | ((Const (@{const_name "Ex"}, at)) $ (Abs (x, T, t))) =>
       if (needs_lift rty T) then let
         val ([x'], lthy2) = Variable.variant_fixes [x] lthy;
@@ -418,6 +425,13 @@
       in
         Const(@{const_name "All"}, at) $ lam_term
       end
+  | ((Const (@{const_name "Ex"}, at)) $ P) =>
+      let
+        val (_, [al, _]) = dest_Type (fastype_of P);
+        val ([x], lthy2) = Variable.variant_fixes [""] lthy;
+        val v = (Free (x, al));
+        val abs = Term.lambda_name (x, v) (P $ v);
+      in regularise ((Const (@{const_name "Ex"}, at)) $ abs) rty rel lthy2 end
   | a $ b => (regularise a rty rel lthy) $ (regularise b rty rel lthy)
   | _ => trm
 
@@ -427,7 +441,8 @@
   cterm_of @{theory} (regularise @{term "\<lambda>x :: int. x"} @{typ "trm"} @{term "RR"} @{context});
   cterm_of @{theory} (regularise @{term "\<lambda>x :: trm. x"} @{typ "trm"} @{term "RR"} @{context});
   cterm_of @{theory} (regularise @{term "\<forall>x :: trm. P x"} @{typ "trm"} @{term "RR"} @{context});
-  cterm_of @{theory} (regularise @{term "\<exists>x :: trm. P x"} @{typ "trm"} @{term "RR"} @{context})
+  cterm_of @{theory} (regularise @{term "\<exists>x :: trm. P x"} @{typ "trm"} @{term "RR"} @{context});
+  cterm_of @{theory} (regularise @{term "All (P :: trm \<Rightarrow> bool)"} @{typ "trm"} @{term "RR"} @{context});
 *}
 
 
@@ -1127,8 +1142,18 @@
   done
 
 thm list.induct
+lemma list_induct2:
+  shows "(P []) \<Longrightarrow> (\<forall> a list. ((P list) \<longrightarrow> (P (a # list)))) \<Longrightarrow> \<forall>l :: 'a list. (P l)"
+  apply (rule allI)
+  apply (rule list.induct)
+  apply (assumption)
+  apply (auto)
+  done
 
-ML {* val li = Thm.freezeT (atomize_thm @{thm list.induct}) *}
+ML {* ObjectLogic.atomize (cprop_of @{thm list_induct2}) *}
+ML {* (atomize_thm @{thm list_induct2}) *}
+
+ML {* val li = Thm.freezeT (atomize_thm @{thm list_induct2}) *}
 
 (* TODO: the following 2 lemmas should go to quotscript.thy after all are done *)
 lemma RIGHT_RES_FORALL_REGULAR:
@@ -1147,41 +1172,18 @@
 
 prove {*
  Logic.mk_implies
-   ((regularise (prop_of li) @{typ "'a List.list"} @{term "op \<approx>"} @{context}),
-   (prop_of li)) *}
+   ((prop_of li),
+   (regularise (prop_of li) @{typ "'a List.list"} @{term "op \<approx>"} @{context})) *}
   apply (simp only: equiv_res_forall[OF equiv_list_eq])
-  thm LEFT_RES_FORALL_REGULAR
-  apply (rule LEFT_RES_FORALL_REGULAR)
+  thm RIGHT_RES_FORALL_REGULAR
+  apply (rule RIGHT_RES_FORALL_REGULAR)
   prefer 2
   apply (assumption)
-  apply (erule thin_rl)
   apply (rule allI)
-  apply (rule conjI)
-  prefer 2
+  apply (rule impI)
   apply (rule impI)
-
-  apply (auto)
-  
-  apply (simp)
-  apply (thin_tac 1)
-.
-  apply (simp)
-
-  apply (unfold Ball_def)
-  apply (simp only: IN_RESPECTS)
-  apply (simp add: expand_fun_eq)
-
-
-  apply (tactic {* foo_tac' @{context} 1 *})
-  apply (atomize(full))
-  apply (simp)
-  prefer 2
-  apply (simp only: IN_RESPECTS)
-  apply (simp add:list_eq_refl)
-  apply (tactic {* foo_tac' @{context} 1 *})
-  prefer 2
-  apply (auto)
-  sorry
+  apply (assumption)
+  done
 
 ML {*
   val m1_novars = snd(no_vars ((Context.Theory @{theory}), @{thm list.induct}))