diff -r a746d49b0240 -r 331873ebc5cd Nominal/nominal_dt_alpha.ML --- a/Nominal/nominal_dt_alpha.ML Sun Aug 22 14:02:49 2010 +0800 +++ b/Nominal/nominal_dt_alpha.ML Wed Aug 25 09:02:06 2010 +0800 @@ -240,7 +240,7 @@ val all_alpha_names = map (fn (a, ty) => ((Binding.name a, ty), NoSyn)) (alpha_names @ alpha_bn_names ~~ alpha_tys @ alpha_bn_tys) val all_alpha_intros = map (pair Attrib.empty_binding) (flat alpha_intros @ flat alpha_bn_intros) - + val (alphas, lthy') = Inductive.add_inductive_i {quiet_mode = true, verbose = false, alt_name = Binding.empty, coind = false, no_elim = false, no_ind = false, skip_mono = false, fork_mono = false} @@ -252,12 +252,13 @@ val alpha_cases_loc = #elims alphas; val phi = ProofContext.export_morphism lthy' lthy; - val all_alpha_trms = map (Morphism.term phi) all_alpha_trms_loc; + val all_alpha_trms = map (Morphism.term phi) all_alpha_trms_loc + val (all_alpha_trms', _) = Variable.importT_terms all_alpha_trms lthy val alpha_induct = Morphism.thm phi alpha_induct_loc; val alpha_intros = map (Morphism.thm phi) alpha_intros_loc val alpha_cases = map (Morphism.thm phi) alpha_cases_loc - val (alpha_trms, alpha_bn_trms) = chop (length fvs) all_alpha_trms + val (alpha_trms, alpha_bn_trms) = chop (length fvs) all_alpha_trms' in (alpha_trms, alpha_bn_trms, alpha_intros, alpha_cases, alpha_induct, lthy') end @@ -289,12 +290,16 @@ fun mk_alpha_distincts ctxt cases_thms distinct_thms alpha_trms alpha_tys = let + (* proper import of type-variables does not work, + since ther are replaced by new variables, messing + up the ty_term assoc list *) + val distinct_thms' = map Thm.legacy_freezeT distinct_thms val ty_trm_assoc = alpha_tys ~~ alpha_trms fun mk_alpha_distinct distinct_trm = let val ([trm'], ctxt') = Variable.import_terms true [distinct_trm] ctxt - val goal = mk_distinct_goal ty_trm_assoc trm' + val goal = mk_distinct_goal ty_trm_assoc distinct_trm in Goal.prove ctxt' [] [] goal (K (distinct_tac cases_thms distinct_thms 1)) @@ -302,7 +307,8 @@ end in - map (mk_alpha_distinct o prop_of) distinct_thms + map (mk_alpha_distinct o prop_of) distinct_thms' + |> map Thm.varifyT_global end