diff -r 49bdb8d475df -r 7c8cd6eae8e2 Nominal/Fv.thy --- 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