Nominal/Fv.thy
changeset 1389 d0ba4829a76c
parent 1388 ad38ca4213f4
child 1390 4e364acdddcc
--- a/Nominal/Fv.thy	Wed Mar 10 10:11:20 2010 +0100
+++ b/Nominal/Fv.thy	Wed Mar 10 10:47:21 2010 +0100
@@ -234,7 +234,7 @@
   val (_, (_, _, constrs)) = nth descr ith_dtyp;
   val eqs = map2i alpha_bn_constr constrs args_in_bns
 in
-  ((bn, alpha_bn_name), (alpha_bn_free, eqs))
+  ((bn, alpha_bn_free), (alpha_bn_name, eqs))
 end
 *}
 
@@ -261,9 +261,10 @@
   val alpha_frees = map Free (alpha_names ~~ alpha_types);
   (* We assume that a bn is either recursive or not *)
   val bns_rec = map (fn (bn, _, _) => not (bn mem nr_bns)) bns;
-
-  val alpha_bnfrees = map (fst o snd) (map (alpha_bn thy dt_info alpha_frees) (bns ~~ bns_rec))
-
+  val (bn_alpha_bns, alpha_bn_names_eqs) = split_list (map (alpha_bn thy dt_info alpha_frees) (bns ~~ bns_rec))
+  val (alpha_bn_names, alpha_bn_eqs) = split_list alpha_bn_names_eqs;
+  val alpha_bn_frees = map snd bn_alpha_bns;
+  val alpha_bn_types = map fastype_of alpha_bn_frees;
   fun fv_alpha_constr ith_dtyp (cname, dts) bindcs =
     let
       val Ts = map (typ_of_dtyp descr sorts) dts;
@@ -329,7 +330,7 @@
             (* TODO: if more then check and accept *)
           | (_, [], []) => @{term True}
           | ([], [(((SOME (bn, _)), _, _), pi)], []) =>
-              nth alpha_bnfrees (find_index (fn (b, _, _) => b = bn) bns) $ pi $ arg $ arg2
+              nth alpha_bn_frees (find_index (fn (b, _, _) => b = bn) bns) $ pi $ arg $ arg2
           | ([], [], relevant) =>
             let
               val (rbinds, rpis) = split_list relevant
@@ -380,8 +381,9 @@
   val (alphas, lthy''') = (Inductive.add_inductive_i
      {quiet_mode = true, verbose = false, alt_name = Binding.empty,
       coind = false, no_elim = false, no_ind = false, skip_mono = true, fork_mono = false}
-     (map2 (fn x => fn y => ((Binding.name x, y), NoSyn)) alpha_names alpha_types) []
-     (add_binds alpha_eqs) [] lthy'')
+     (map2 (fn x => fn y => ((Binding.name x, y), NoSyn)) (alpha_names @ alpha_bn_names)
+     (alpha_types @ alpha_bn_types)) []
+     (add_binds (alpha_eqs @ flat alpha_bn_eqs)) [] lthy'')
   val all_fvs = (fst fvs @ fst fvs2, snd fvs @ snd fvs2)
 in
   ((all_fvs, alphas), lthy''')
@@ -390,29 +392,24 @@
 
 (*
 atom_decl name
-
 datatype lam =
   VAR "name"
 | APP "lam" "lam"
 | LET "bp" "lam"
 and bp =
   BP "name" "lam"
-
 primrec
   bi::"bp \<Rightarrow> atom set"
 where
   "bi (BP x t) = {atom x}"
-
 setup {* snd o define_raw_perms (Datatype.the_info @{theory} "Fv.lam") 2 *}
-
-
 local_setup {*
   snd o define_fv_alpha (Datatype.the_info @{theory} "Fv.lam")
-  [[[], [], [(SOME (@{term bi}, false), 0, 1)]], [[]]] [(@{term bi}, 1, [[0]])] *}
+  [[[], [], [(SOME (@{term bi}, true), 0, 1)]], [[]]] [(@{term bi}, 1, [[0]])] *}
 print_theorems
 *)
 
-(*
+(*atom_decl name
 datatype rtrm1 =
   rVr1 "name"
 | rAp1 "rtrm1" "rtrm1"
@@ -422,24 +419,38 @@
   BUnit
 | BVr "name"
 | BPr "bp" "bp"
-
-(* to be given by the user *)
-
 primrec
   bv1
 where
   "bv1 (BUnit) = {}"
 | "bv1 (BVr x) = {atom x}"
 | "bv1 (BPr bp1 bp2) = (bv1 bp1) \<union> (bv1 bp1)"
-
-setup {* snd o define_raw_perms ["rtrm1", "bp"] ["Fv.rtrm1", "Fv.bp"] *}
-
-local_setup {* define_fv_alpha "Fv.rtrm1"
-  [[[[]], [[], []], [[(NONE, 0)], [(NONE, 0)]], [[(SOME @{term bv1}, 0)], [], [(SOME @{term bv1}, 0)]]],
-   [[], [[]], [[], []]]] *}
+setup {* snd o define_raw_perms (Datatype.the_info @{theory} "Fv.rtrm1") 2 *}
+local_setup {*
+  snd o define_fv_alpha (Datatype.the_info @{theory} "Fv.rtrm1")
+  [[[], [], [(NONE, 0, 1)], [(SOME (@{term bv1}, false), 0, 2)]],
+  [[], [], []]] [(@{term bv1}, 1, [[], [0], [0, 1]])] *}
 print_theorems
 *)
 
+(*
+atom_decl name
+datatype rtrm5 =
+  rVr5 "name"
+| rLt5 "rlts" "rtrm5" --"bind (bv5 lts) in (rtrm5)"
+and rlts =
+  rLnil
+| rLcons "name" "rtrm5" "rlts"
+primrec
+  rbv5
+where
+  "rbv5 rLnil = {}"
+| "rbv5 (rLcons n t ltl) = {atom n} \<union> (rbv5 ltl)"
+setup {* snd o define_raw_perms (Datatype.the_info @{theory} "Fv.rtrm5") 2 *}
+local_setup {* snd o define_fv_alpha (Datatype.the_info @{theory} "Fv.rtrm5")
+  [[[], [(SOME (@{term rbv5}, false), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [0, 2]])] *}
+print_theorems
+*)
 
 ML {*
 fun alpha_inj_tac dist_inj intrs elims =