Nominal/Fv.thy
changeset 1457 91fe914e1bef
parent 1454 7c8cd6eae8e2
child 1462 7c59dd8e5435
--- a/Nominal/Fv.thy	Tue Mar 16 16:17:05 2010 +0100
+++ b/Nominal/Fv.thy	Tue Mar 16 16:51:06 2010 +0100
@@ -209,19 +209,22 @@
   val {descr, sorts, ...} = dt_info;
   fun nth_dtyp i = typ_of_dtyp descr sorts (DtRec i);
   val alpha_bn_name = "alpha_" ^ (Long_Name.base_name (fst (dest_Const bn)));
-  val alpha_bn_type = @{typ perm} --> nth_dtyp ith_dtyp --> nth_dtyp ith_dtyp --> @{typ bool}
+  val alpha_bn_type = 
+    if is_rec then @{typ perm} --> nth_dtyp ith_dtyp --> nth_dtyp ith_dtyp --> @{typ bool}
+    else nth_dtyp ith_dtyp --> nth_dtyp ith_dtyp --> @{typ bool};
   val alpha_bn_free = Free(alpha_bn_name, alpha_bn_type);
+  val pi = Free("pi", @{typ perm})
+  val alpha_bn_pi = if is_rec then alpha_bn_free $ pi else alpha_bn_free;
   fun alpha_bn_constr (cname, dts) args_in_bn =
   let
     val Ts = map (typ_of_dtyp descr sorts) dts;
-    val pi = Free("pi", @{typ perm})
     val names = Name.variant_list ["pi"] (Datatype_Prop.make_tnames Ts);
     val names2 = Name.variant_list ("pi" :: names) (Datatype_Prop.make_tnames Ts);
     val args = map Free (names ~~ Ts);
     val args2 = map Free (names2 ~~ Ts);
     val c = Const (cname, Ts ---> (nth_dtyp ith_dtyp));
     val rhs = HOLogic.mk_Trueprop
-      (alpha_bn_free $ pi $ (list_comb (c, args)) $ (list_comb (c, args2)));
+      (alpha_bn_pi $ (list_comb (c, args)) $ (list_comb (c, args2)));
     fun lhs_arg ((dt, arg_no), (arg, arg2)) =
       let
         val argty = fastype_of arg;
@@ -229,7 +232,7 @@
         val permarg = if is_rec then permute $ pi $ arg else arg
       in
       if is_rec_type dt then
-        if arg_no mem args_in_bn then alpha_bn_free $ pi $ arg $ arg2
+        if arg_no mem args_in_bn then alpha_bn_pi $ arg $ arg2
         else (nth alpha_frees (body_index dt)) $ permarg $ arg2
       else
         if arg_no mem args_in_bn then @{term True}
@@ -351,9 +354,12 @@
               if is_rec_type dt then (nth alpha_frees (body_index dt) $ arg $ arg2)
               else (HOLogic.mk_eq (arg, arg2))
           | (_, [], []) => @{term True}
-          | ([], ((((SOME (bn, _)), _, _), pi) :: _), []) =>
+          | ([], ((((SOME (bn, is_rec)), _, _), pi) :: _), []) =>
             let
-              val alpha_bn = nth alpha_bn_frees (find_index (fn (b, _, _) => b = bn) bns) $ pi $ arg $ arg2
+              val alpha_bn_const =
+                nth alpha_bn_frees (find_index (fn (b, _, _) => b = bn) bns)
+              val alpha_bn =
+                if is_rec then alpha_bn_const $ pi $ arg $ arg2 else alpha_bn_const $ arg $ arg2
               val ty = fastype_of (bn $ arg)
               val permute = Const(@{const_name permute}, @{typ perm} --> ty --> ty)
             in