logically separate typedef axiomatization from constant definition
authorkrauss
Mon, 08 Dec 2008 08:56:30 +0100
changeset 29054 6f61794f1ff7
parent 29053 077fb9b16119
child 29055 edaef19665e6
logically separate typedef axiomatization from constant definition
src/HOL/Tools/typedef_package.ML
--- a/src/HOL/Tools/typedef_package.ML	Mon Dec 08 08:36:16 2008 +0100
+++ b/src/HOL/Tools/typedef_package.ML	Mon Dec 08 08:56:30 2008 +0100
@@ -90,10 +90,6 @@
     val rhs_tfreesT = Term.add_tfreesT setT [];
     val oldT = HOLogic.dest_setT setT handle TYPE _ =>
       error ("Not a set type: " ^ quote (Syntax.string_of_typ ctxt setT));
-    fun mk_inhabited A =
-      HOLogic.mk_Trueprop (HOLogic.mk_exists ("x", oldT, HOLogic.mk_mem (Free ("x", oldT), A)));
-    val goal = mk_inhabited set;
-    val goal_pat = mk_inhabited (Var (the_default (name, 0) (Syntax.read_variable name), setT));
 
     (*lhs*)
     val defS = Sign.defaultS thy;
@@ -113,6 +109,10 @@
     val AbsC = Const (full Abs_name, oldT --> newT);
 
     val set' = if def then setC else set;
+    fun mk_inhabited A =
+      HOLogic.mk_Trueprop (HOLogic.mk_exists ("x", oldT, HOLogic.mk_mem (Free ("x", oldT), A)));
+    val goal = mk_inhabited set';
+    val term_binding = (the_default (name, 0) (Syntax.read_variable name), SOME set)
 
     val typedef_name = "type_definition_" ^ name;
     val typedefC =
@@ -203,7 +203,7 @@
     val _ = test_thy
       |> typedef_result (setmp quick_and_dirty true (SkipProof.make_thm test_thy) goal);
 
-  in ((set, goal, goal_pat, typedef_result), thy') end
+  in ((set, goal, term_binding, set_def, typedef_result), thy') end
   handle ERROR msg => err_in_typedef msg name;
 
 
@@ -212,7 +212,7 @@
 fun add_typedef def opt_name typ set opt_morphs tac thy =
   let
     val name = the_default (#1 typ) opt_name;
-    val ((set, goal, _, typedef_result), thy') =
+    val ((set, goal, _, set_def, typedef_result), thy') =
       prepare_typedef Syntax.check_term def name typ set opt_morphs thy;
     val non_empty = Goal.prove_global thy' [] [] goal (K tac)
       handle ERROR msg => cat_error msg
@@ -226,10 +226,16 @@
 
 fun gen_typedef prep_term ((def, name), typ, set, opt_morphs) thy =
   let
-    val ((_, goal, goal_pat, typedef_result), thy') =
+    val ((_, goal, term_binding, set_def, typedef_result), thy') =
       prepare_typedef prep_term def name typ set opt_morphs thy;
     fun after_qed [[th]] = ProofContext.theory (snd o typedef_result th);
-  in Proof.theorem_i NONE after_qed [[(goal, [goal_pat])]] (ProofContext.init thy') end;
+  in 
+    Proof.theorem_i NONE after_qed [[(goal, [])]] (ProofContext.init thy')
+    |> Proof.add_binds_i [term_binding] 
+    |> (if def 
+        then Seq.hd o Proof.refine (Method.Basic (Method.unfold [the set_def], Position.none))
+        else I)
+  end;
 
 in