# HG changeset patch
# User Christian Urban <urbanc@in.tum.de>
# Date 1272428650 -7200
# Node ID 4a3c05fe2bc509cd937d58e9d01f259da4beeabb
# Parent  209ee65b2395b00fbb1d10db40052fea9d9afffb
closed Datatype_Aux; replaced nth_dtyp by the function used in Perm.thy

diff -r 209ee65b2395 -r 4a3c05fe2bc5 Nominal/NewFv.thy
--- a/Nominal/NewFv.thy	Tue Apr 27 23:11:40 2010 +0200
+++ b/Nominal/NewFv.thy	Wed Apr 28 06:24:10 2010 +0200
@@ -12,17 +12,16 @@
 *}
 
 ML {*
-  open Datatype_Aux; (* typ_of_dtyp, DtRec, ... *);
+fun mk_singleton_atom x = HOLogic.mk_set @{typ atom} [mk_atom x];
 
-  fun mk_single_atom x = HOLogic.mk_set @{typ atom} [mk_atom x];
+val noatoms = @{term "{} :: atom set"};
 
-  val noatoms = @{term "{} :: atom set"};
-  fun mk_union sets =
-    fold (fn a => fn b =>
-      if a = noatoms then b else
-      if b = noatoms then a else
-      if a = b then a else
-      HOLogic.mk_binop @{const_name sup} (a, b)) (rev sets) noatoms;
+fun mk_union sets =
+  fold (fn a => fn b =>
+  if a = noatoms then b else
+  if b = noatoms then a else
+  if a = b then a else
+  HOLogic.mk_binop @{const_name sup} (a, b)) (rev sets) noatoms;
 *}
 
 ML {*
@@ -66,7 +65,7 @@
   val ty = fastype_of t;
 in
   if is_atom thy ty 
-    then mk_single_atom t 
+    then mk_singleton_atom t 
   else if is_atom_set thy ty 
     then mk_atom_set t 
   else if is_atom_fset thy ty 
@@ -90,7 +89,9 @@
       val x = nth args i;
       val dt = nth dts i;
     in
-      if is_rec_type dt then nth fv_frees (body_index dt) $ x else atoms thy x
+      if Datatype_Aux.is_rec_type dt 
+      then nth fv_frees (Datatype_Aux.body_index dt) $ x 
+      else atoms thy x
     end
   val fv_bodys = mk_union (map fv_body bodys)
   val bound_vars =
@@ -118,7 +119,9 @@
       val dt = nth dts i;
     in
       case AList.lookup (op=) args_in_bn i of
-        NONE => if is_rec_type dt then nth fv_frees (body_index dt) $ x else atoms thy x
+        NONE => if Datatype_Aux.is_rec_type dt 
+                then nth fv_frees (Datatype_Aux.body_index dt) $ x 
+                else atoms thy x
       | SOME (SOME (f : term)) => (the (AList.lookup (op=) bn_fvbn f)) $ x
       | SOME NONE => noatoms
     end
@@ -132,13 +135,12 @@
   bn_fvbn bmll (fvbn, (_, ith_dtyp, args_in_bns)) =
 let
   val {descr, sorts, ...} = dt_info;
-  fun nth_dtyp i = typ_of_dtyp descr sorts (DtRec i);
   fun fv_bn_constr (cname, dts) (args_in_bn, bml) =
   let
-    val Ts = map (typ_of_dtyp descr sorts) dts;
+    val Ts = map (Datatype_Aux.typ_of_dtyp descr sorts) dts;
     val names = Datatype_Prop.make_tnames Ts;
     val args = map Free (names ~~ Ts);
-    val c = Const (cname, Ts ---> (nth_dtyp ith_dtyp));
+    val c = Const (cname, Ts ---> (nth_dtyp 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
@@ -176,7 +178,9 @@
       val x = nth args i;
       val dt = nth dts i;
     in
-      if is_rec_type dt then nth fv_frees (body_index dt) $ x else atoms thy x
+      if Datatype_Aux.is_rec_type dt 
+      then nth fv_frees (Datatype_Aux.body_index dt) $ x 
+      else atoms thy x
     end
 | BLst (x, y) => fv_bm_lsts thy dts args fv_frees bn_fvbn x y
 | BSet (x, y) => fv_bm_lsts thy dts args fv_frees bn_fvbn x y
@@ -187,13 +191,12 @@
 fun fv thy (dt_info : Datatype_Aux.info) fv_frees bn_fvbn bmll (fv_free, ith_dtyp) =
 let
   val {descr, sorts, ...} = dt_info;
-  fun nth_dtyp i = typ_of_dtyp descr sorts (DtRec i);
   fun fv_constr (cname, dts) bml =
   let
-    val Ts = map (typ_of_dtyp descr sorts) dts;
+    val Ts = map (Datatype_Aux.typ_of_dtyp descr sorts) dts;
     val names = Datatype_Prop.make_tnames Ts;
     val args = map Free (names ~~ Ts);
-    val c = Const (cname, Ts ---> (nth_dtyp ith_dtyp));
+    val c = Const (cname, Ts ---> (nth_dtyp descr sorts ith_dtyp));
     val fv_bn_bm = fv_bm thy dts args fv_frees bn_fvbn
   in
     HOLogic.mk_Trueprop (HOLogic.mk_eq
@@ -216,24 +219,26 @@
   #> Proof.global_terminal_proof (Method.Basic method, NONE)
 *}
 
-
-
 ML {*
 fun define_raw_fv dt_info bns bmlll lthy =
 let
   val thy = ProofContext.theory_of lthy;
   val {descr, sorts, ...} = dt_info;
-  fun nth_dtyp i = typ_of_dtyp descr sorts (DtRec i);
+
   val fv_names = Datatype_Prop.indexify_names (map (fn (i, _) =>
-    "fv_" ^ name_of_typ (nth_dtyp i)) descr);
-  val fv_types = map (fn (i, _) => nth_dtyp i --> @{typ "atom set"}) descr;
+    "fv_" ^ Datatype_Aux.name_of_typ (nth_dtyp descr sorts i)) descr);
+
+  val fv_types = map (fn (i, _) => nth_dtyp descr sorts i --> @{typ "atom set"}) descr;
   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 bns bmlll;
+
   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) bmlll (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)
+
   val lthy' =
     lthy
     |> Function.add_function fv_names fv_eqs_binds Function_Common.default_config