Nominal/nominal_dt_alpha.ML
changeset 2957 01ff621599bc
parent 2928 c537d43c09f1
child 3029 6fd3fc3254ee
--- a/Nominal/nominal_dt_alpha.ML	Wed Jul 06 15:59:11 2011 +0200
+++ b/Nominal/nominal_dt_alpha.ML	Thu Jul 07 16:16:42 2011 +0200
@@ -9,8 +9,8 @@
 sig
   val comb_binders: Proof.context -> bmode -> term list -> (term option * int) list -> term
 
-  val define_raw_alpha: string list -> typ list -> cns_info list -> bn_info list -> 
-    bclause list list list -> term list -> Proof.context -> alpha_result * local_theory
+  val define_raw_alpha: raw_dt_info -> bn_info list -> bclause list list list -> term list -> 
+    Proof.context -> alpha_result * local_theory
 
   val induct_prove: typ list -> (typ * (term -> term)) list -> thm -> 
     (Proof.context -> int -> tactic) -> Proof.context -> thm list
@@ -18,8 +18,8 @@
   val alpha_prove: term list -> (term * ((term * term) -> term)) list -> thm -> 
     (Proof.context -> int -> tactic) -> Proof.context -> thm list
 
-  val raw_prove_alpha_distincts: Proof.context -> alpha_result -> thm list -> string list -> thm list
-  val raw_prove_alpha_eq_iff: Proof.context -> alpha_result -> thm list -> thm list -> thm list
+  val raw_prove_alpha_distincts: Proof.context -> alpha_result -> raw_dt_info -> thm list
+  val raw_prove_alpha_eq_iff: Proof.context -> alpha_result -> raw_dt_info -> thm list
   val raw_prove_refl: Proof.context -> alpha_result -> thm -> thm list
   val raw_prove_sym: Proof.context -> alpha_result -> thm list -> thm list
   val raw_prove_trans: Proof.context -> alpha_result -> thm list -> thm list -> thm list
@@ -224,9 +224,11 @@
     map2 (mk_alpha_bn_intro lthy bn_trm alpha_map alpha_bn_map) (bn_argss ~~ nth_constrs_info) nth_bclausess
   end
 
-fun define_raw_alpha raw_full_ty_names raw_tys cns_info bn_info bclausesss fvs lthy =
+fun define_raw_alpha raw_dt_info bn_info bclausesss fvs lthy =
   let
-    val alpha_names = map (prefix "alpha_" o Long_Name.base_name) raw_full_ty_names
+    val RawDtInfo {raw_dt_names, raw_tys, raw_cns_info, ...} = raw_dt_info
+
+    val alpha_names = map (prefix "alpha_" o Long_Name.base_name) raw_dt_names
     val alpha_tys = map (fn ty => [ty, ty] ---> @{typ bool}) raw_tys
     val alpha_frees = map Free (alpha_names ~~ alpha_tys)
     val alpha_map = raw_tys ~~ (alpha_frees ~~ fvs)
@@ -239,8 +241,8 @@
     val alpha_bn_frees = map Free (alpha_bn_names ~~ alpha_bn_tys)
     val alpha_bn_map = bns ~~ alpha_bn_frees
 
-    val alpha_intros = map2 (map2 (mk_alpha_intros lthy alpha_map alpha_bn_map)) cns_info bclausesss 
-    val alpha_bn_intros = map (mk_alpha_bn_intros lthy alpha_map alpha_bn_map cns_info bclausesss) bn_info
+    val alpha_intros = map2 (map2 (mk_alpha_intros lthy alpha_map alpha_bn_map)) raw_cns_info bclausesss 
+    val alpha_bn_intros = map (mk_alpha_bn_intros lthy alpha_map alpha_bn_map raw_cns_info bclausesss) bn_info
 
     val all_alpha_names = map (fn (a, ty) => ((Binding.name a, ty), NoSyn))
       (alpha_names @ alpha_bn_names ~~ alpha_tys @ alpha_bn_tys)
@@ -393,9 +395,10 @@
   rtac notI THEN' eresolve_tac cases_thms 
   THEN_ALL_NEW asm_full_simp_tac (HOL_ss addsimps distinct_thms)
 
-fun raw_prove_alpha_distincts ctxt alpha_result raw_distinct_thms raw_dt_names =
+fun raw_prove_alpha_distincts ctxt alpha_result raw_dt_info =
   let
     val AlphaResult {alpha_names, alpha_cases, ...} = alpha_result
+    val RawDtInfo {raw_dt_names, raw_distinct_thms, ...} = raw_dt_info
 
     val ty_trm_assoc = raw_dt_names ~~ alpha_names
 
@@ -439,9 +442,10 @@
     else HOLogic.mk_Trueprop (HOLogic.mk_eq (concl, list_conj hyps))
   end;
 
-fun raw_prove_alpha_eq_iff ctxt alpha_result raw_distinct_thms raw_inject_thms =
+fun raw_prove_alpha_eq_iff ctxt alpha_result raw_dt_info =
   let
     val AlphaResult {alpha_intros, alpha_cases, ...} = alpha_result
+    val RawDtInfo {raw_distinct_thms, raw_inject_thms, ...} = raw_dt_info
 
     val ((_, thms_imp), ctxt') = Variable.import false alpha_intros ctxt;
     val goals = map mk_alpha_eq_iff_goal thms_imp;