diff -r 4049a2651dd9 -r 01ff621599bc Nominal/nominal_dt_alpha.ML --- 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;