tuned last commit
authorChristian Urban <urbanc@in.tum.de>
Tue, 31 May 2011 00:36:16 +0100
changeset 2790 d2154b421707
parent 2789 32979078bfe9
child 2791 5d0875b7ed3e
tuned last commit
Nominal/nominal_function_core.ML
--- a/Nominal/nominal_function_core.ML	Tue May 31 00:17:22 2011 +0100
+++ b/Nominal/nominal_function_core.ML	Tue May 31 00:36:16 2011 +0100
@@ -123,28 +123,26 @@
     |> HOLogic.mk_Trueprop
   end
 
-fun mk_eqvt_proof_obligation qs fvar (assms, arg) = 
+(** building proof obligations *)
+fun mk_eqvt_proof_obligation qs fvar (_, assms, arg) = 
   mk_eqvt_at (fvar, arg)
-  |> curry Logic.list_implies assms
+  |> curry Logic.list_implies (map prop_of assms)
   |> curry Term.list_abs_free qs
   |> strip_abs_body
 
 (** building proof obligations *)
-
-fun mk_compat_proof_obligations lthy domT ranT fvar f RCss glrs =
+fun mk_compat_proof_obligations domT ranT fvar f RCss glrs =
   let
     fun mk_impl (((qs, gs, lhs, rhs), RCs), ((qs', gs', lhs', rhs'), _)) =
       let
         val shift = incr_boundvars (length qs')
-     
-        val rc_args = map (fn (_, thms, args) => (map prop_of thms, args)) RCs
-        val tt = map (shift o mk_eqvt_proof_obligation qs fvar) rc_args
+        val eqvts_proof_obligations = map (shift o mk_eqvt_proof_obligation qs fvar) RCs
       in
         Logic.mk_implies
           (HOLogic.mk_Trueprop (HOLogic.eq_const domT $ shift lhs $ lhs'),
             HOLogic.mk_Trueprop (HOLogic.eq_const ranT $ shift rhs $ rhs'))
         |> fold_rev (curry Logic.mk_implies) (map shift gs @ gs')
-        |> fold_rev (curry Logic.mk_implies) tt (* nominal *)
+        |> fold_rev (curry Logic.mk_implies) eqvts_proof_obligations (* nominal *)
         |> fold_rev (fn (n,T) => fn b => Term.all T $ Abs(n,T,b)) (qs @ qs')
         |> curry abstract_over fvar
         |> curry subst_bound f
@@ -958,7 +956,7 @@
       mk_completeness globals clauses abstract_qglrs |> cert |> Thm.assume
 
     val compat =
-      mk_compat_proof_obligations lthy domT ranT fvar f RCss abstract_qglrs 
+      mk_compat_proof_obligations domT ranT fvar f RCss abstract_qglrs 
       |> map (cert #> Thm.assume)
 
     val G_eqvt = mk_eqvt G |> cert |> Thm.assume