Nominal/Fv.thy
changeset 1454 7c8cd6eae8e2
parent 1452 31f000d586bb
child 1457 91fe914e1bef
--- a/Nominal/Fv.thy	Tue Mar 16 12:08:37 2010 +0100
+++ b/Nominal/Fv.thy	Tue Mar 16 15:27:47 2010 +0100
@@ -154,6 +154,16 @@
 end
 *}
 
+ML {*
+fun all_binds l =
+let
+  fun is_non_rec (SOME (f, _), _, _) = SOME f
+    | is_non_rec _ = NONE
+in
+  distinct (op =) (map_filter is_non_rec (flat (flat l)))
+end
+*}
+
 (* We assume no bindings in the type on which bn is defined *)
 ML {*
 fun fv_bn thy (dt_info : Datatype_Aux.info) fv_frees (bn, ith_dtyp, args_in_bns) =
@@ -244,8 +254,6 @@
   length (distinct (op =) (map (fn ((b, _, _), _) => b) l)) = 1
 *}
 
-ML {* fn x => split_list(flat x) *}
-ML {* fn x => apsnd flat (split_list (map split_list x)) *}
 (* TODO: Notice datatypes without bindings and replace alpha with equality *)
 ML {*
 fun define_fv_alpha (dt_info : Datatype_Aux.info) bindsall bns lthy =
@@ -257,8 +265,9 @@
     "fv_" ^ name_of_typ (nth_dtyp i)) descr);
   val fv_types = map (fn (i, _) => nth_dtyp i --> @{typ "atom set"}) descr;
   val fv_frees = map Free (fv_names ~~ fv_types);
+  val all_bns = all_binds bindsall;
   val nr_bns = non_rec_binds bindsall;
-  val rel_bns = filter (fn (bn, _, _) => bn mem nr_bns) bns;
+  val rel_bns = filter (fn (bn, _, _) => bn mem all_bns) bns;
   val (bn_fv_bns, fv_bn_names_eqs) = split_list (map (fv_bn thy dt_info fv_frees) rel_bns);
   val (fv_bn_names, fv_bn_eqs) = split_list fv_bn_names_eqs;
   val alpha_names = Datatype_Prop.indexify_names (map (fn (i, _) =>
@@ -297,13 +306,21 @@
             @{term "{} :: atom set"}
         | fv_bind args (SOME (f, _), i, _) = f $ (nth args i);
       fun fv_binds args relevant = mk_union (map (fv_bind args) relevant)
-      fun find_nonrec_binder j (SOME (f, false), i, _) = if i = j then SOME f else NONE
-        | find_nonrec_binder _ _ = NONE
+      fun find_compound_binder j (SOME (f, r), i, _) = if i = j then SOME (f, r) else NONE
+        | find_compound_binder _ _ = NONE
       fun fv_arg ((dt, x), arg_no) =
-        case get_first (find_nonrec_binder arg_no) bindcs of
-          SOME f =>
+        case get_first (find_compound_binder arg_no) bindcs of
+          SOME (f, is_rec) =>
             (case get_first (fn (x, y) => if x = f then SOME y else NONE) bn_fv_bns of
-                SOME fv_bn => fv_bn $ x
+                SOME fv_bn =>
+                  if is_rec then
+                    let
+                      val relevant = filter (fn (_, i, j) => ((i = arg_no) orelse (j = arg_no))) bindcs;
+                      val sub = fv_binds args relevant
+                    in
+                      mk_diff (fv_bn $ x) sub
+                    end
+                  else fv_bn $ x
               | NONE => error "bn specified in a non-rec binding but not in bn list")
         | NONE =>
             let
@@ -312,7 +329,7 @@
                 if ((is_atom thy) o fastype_of) x then mk_single_atom x else
                 if ((is_atom_set thy) o fastype_of) x then mk_atoms x else
                 (* TODO we do not know what to do with non-atomizable things *)
-                @{term "{} :: atom set"}
+                @{term "{} :: atom set"};
               (* If i = j then we generate it only once *)
               val relevant = filter (fn (_, i, j) => ((i = arg_no) orelse (j = arg_no))) bindcs;
               val sub = fv_binds args relevant