--- a/Nominal/NewFv.thy Wed Apr 28 06:55:07 2010 +0200
+++ b/Nominal/NewFv.thy Wed Apr 28 07:09:11 2010 +0200
@@ -131,29 +131,28 @@
*}
ML {*
-fun fv_bn thy (dt_info : Datatype_Aux.info) fv_frees
+fun fv_bn thy dt_descr sorts fv_frees
bn_fvbn bmll (fvbn, (_, ith_dtyp, args_in_bns)) =
let
- val {descr, sorts, ...} = dt_info;
fun fv_bn_constr (cname, dts) (args_in_bn, bml) =
let
- val Ts = map (Datatype_Aux.typ_of_dtyp descr sorts) dts;
+ val Ts = map (Datatype_Aux.typ_of_dtyp dt_descr sorts) dts;
val names = Datatype_Prop.make_tnames Ts;
val args = map Free (names ~~ Ts);
- val c = Const (cname, Ts ---> (nth_dtyp descr sorts ith_dtyp));
+ val c = Const (cname, Ts ---> (nth_dtyp dt_descr sorts ith_dtyp));
val fv_bn_bm = fv_bn_bm thy dts args fv_frees bn_fvbn args_in_bn
in
HOLogic.mk_Trueprop (HOLogic.mk_eq
(fvbn $ list_comb (c, args), mk_union (map fv_bn_bm bml)))
end;
- val (_, (_, _, constrs)) = nth descr ith_dtyp;
+ val (_, (_, _, constrs)) = nth dt_descr ith_dtyp;
in
map2 fv_bn_constr constrs (args_in_bns ~~ bmll)
end
*}
ML {*
-fun fv_bns thy dt_info fv_frees bn_funs bclauses =
+fun fv_bns thy dt_descr sorts fv_frees bn_funs bclauses =
let
fun mk_fvbn_free (bn, ith, _) =
let
@@ -164,7 +163,7 @@
val (fvbn_names, fvbn_frees) = split_list (map mk_fvbn_free bn_funs);
val bn_fvbn = (map (fn (bn, _, _) => bn) bn_funs) ~~ fvbn_frees
val bmlls = map (fn (_, i, _) => nth bclauses i) bn_funs;
- val eqs = map2 (fv_bn thy dt_info fv_frees bn_fvbn) bmlls (fvbn_frees ~~ bn_funs);
+ val eqs = map2 (fv_bn thy dt_descr sorts fv_frees bn_fvbn) bmlls (fvbn_frees ~~ bn_funs);
in
(bn_fvbn, fvbn_names, eqs)
end
@@ -188,21 +187,20 @@
*}
ML {*
-fun fv thy (dt_info : Datatype_Aux.info) fv_frees bn_fvbn bmll (fv_free, ith_dtyp) =
+fun fv thy dt_descr sorts fv_frees bn_fvbn bmll (fv_free, ith_dtyp) =
let
- val {descr, sorts, ...} = dt_info;
fun fv_constr (cname, dts) bml =
let
- val Ts = map (Datatype_Aux.typ_of_dtyp descr sorts) dts;
+ val Ts = map (Datatype_Aux.typ_of_dtyp dt_descr sorts) dts;
val names = Datatype_Prop.make_tnames Ts;
val args = map Free (names ~~ Ts);
- val c = Const (cname, Ts ---> (nth_dtyp descr sorts ith_dtyp));
+ val c = Const (cname, Ts ---> (nth_dtyp dt_descr sorts ith_dtyp));
val fv_bn_bm = fv_bm thy dts args fv_frees bn_fvbn
in
HOLogic.mk_Trueprop (HOLogic.mk_eq
(fv_free $ list_comb (c, args), mk_union (map fv_bn_bm bml)))
end;
- val (_, (_, _, constrs)) = nth descr ith_dtyp;
+ val (_, (_, _, constrs)) = nth dt_descr ith_dtyp;
in
map2 fv_constr constrs bmll
end
@@ -220,7 +218,7 @@
*}
ML {*
-fun define_raw_fv dt_info bn_funs bclauses lthy =
+fun define_raw_fv (dt_info : Datatype_Aux.info) bn_funs bclauses lthy =
let
val thy = ProofContext.theory_of lthy;
val {descr as dt_descr, sorts, ...} = dt_info;
@@ -230,12 +228,12 @@
val fv_frees = map Free (fv_names ~~ fv_types);
val (bn_fvbn, fv_bn_names, fv_bn_eqs) =
- fv_bns thy dt_info fv_frees bn_funs bclauses;
+ fv_bns thy dt_descr sorts fv_frees bn_funs bclauses;
val fvbns = map snd bn_fvbn;
val fv_nums = 0 upto (length fv_frees - 1)
- val fv_eqs = map2 (fv thy dt_info fv_frees bn_fvbn) bclauses (fv_frees ~~ fv_nums);
+ val fv_eqs = map2 (fv thy dt_descr sorts fv_frees bn_fvbn) bclauses (fv_frees ~~ fv_nums);
val fv_names = map (fn s => (Binding.name s, NONE, NoSyn)) (fv_names @ fv_bn_names)
val fv_eqs_binds = map (fn x => (Attrib.empty_binding, x)) (flat fv_eqs @ flat fv_bn_eqs)