add function add_qualified_simp_thm
authorhuffman
Thu, 04 Mar 2010 08:12:39 -0800
changeset 35573 bd8b50e76e94
parent 35572 44eeda8cb708
child 35574 ee5df989b7c4
add function add_qualified_simp_thm
src/HOLCF/Tools/Domain/domain_take_proofs.ML
--- a/src/HOLCF/Tools/Domain/domain_take_proofs.ML	Wed Mar 03 21:42:42 2010 -0800
+++ b/src/HOLCF/Tools/Domain/domain_take_proofs.ML	Thu Mar 04 08:12:39 2010 -0800
@@ -188,6 +188,13 @@
         (Thm.no_attributes (Binding.name name, thm))
     ||> Sign.parent_path;
 
+fun add_qualified_simp_thm name (path, thm) thy =
+    thy
+    |> Sign.add_path path
+    |> yield_singleton PureThy.add_thms
+        ((Binding.name name, thm), [Simplifier.simp_add])
+    ||> Sign.parent_path;
+
 (******************************************************************************)
 (************************** defining take functions ***************************)
 (******************************************************************************)
@@ -264,11 +271,7 @@
         val tac = simp_tac (HOL_basic_ss addsimps rules) 1;
         val thm = Goal.prove_global thy [] [] goal (K tac);
       in
-        thy
-          |> Sign.add_path dname
-          |> yield_singleton PureThy.add_thms
-              ((Binding.name "chain_take", thm), [Simplifier.simp_add])
-          ||> Sign.parent_path
+        add_qualified_simp_thm "chain_take" (dname, thm) thy
       end;
     val (chain_take_thms, thy) =
       fold_map prove_chain_take (take_consts ~~ dnames) thy;