Nominal/nominal_dt_alpha.ML
changeset 2431 331873ebc5cd
parent 2407 49ab06c0ca64
child 2435 3772bb3bd7ce
--- 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