# HG changeset patch
# User blanchet
# Date 1379529835 -7200
# Node ID f58e289eceba1151a0d6bd80f52b1449d9658160
# Parent  657c89169d1a8c2da9b35de979251ea2de37d375
enrich data structure

diff -r 657c89169d1a -r f58e289eceba src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML
--- a/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML	Wed Sep 18 19:57:59 2013 +0200
+++ b/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML	Wed Sep 18 20:43:55 2013 +0200
@@ -31,6 +31,8 @@
      sels: term list,
      pred: int option,
      calls: corec_call list,
+     discI: thm,
+     sel_thms: thm list,
      collapse: thm,
      corec_thm: thm,
      disc_corec: thm,
@@ -96,6 +98,8 @@
    sels: term list,
    pred: int option,
    calls: corec_call list,
+   discI: thm,
+   sel_thms: thm list,
    collapse: thm,
    corec_thm: thm,
    disc_corec: thm,
@@ -431,11 +435,13 @@
          else No_Corec) g_i
       | call_of _ [q_i] [g_i, g_i'] _ = Direct_Corec (q_i, g_i, g_i');
 
-    fun mk_ctr_spec ctr disc sels p_ho q_iss f_iss f_Tss collapse corec_thm disc_corec sel_corecs =
+    fun mk_ctr_spec ctr disc sels p_ho q_iss f_iss f_Tss discI sel_thms collapse corec_thm
+        disc_corec sel_corecs =
       let val nullary = not (can dest_funT (fastype_of ctr)) in
         {ctr = substA ctr, disc = substA disc, sels = map substA sels, pred = p_ho,
-         calls = map3 (call_of nullary) q_iss f_iss f_Tss, collapse = collapse,
-         corec_thm = corec_thm, disc_corec = disc_corec, sel_corecs = sel_corecs}
+         calls = map3 (call_of nullary) q_iss f_iss f_Tss, discI = discI, sel_thms = sel_thms,
+         collapse = collapse, corec_thm = corec_thm, disc_corec = disc_corec,
+         sel_corecs = sel_corecs}
       end;
 
     fun mk_ctr_specs index ctr_sugars p_is q_isss f_isss f_Tsss coiter_thmsss disc_coitersss
@@ -445,14 +451,16 @@
         val discs = #discs (nth ctr_sugars index);
         val selss = #selss (nth ctr_sugars index);
         val p_ios = map SOME p_is @ [NONE];
+        val discIs = #discIs (nth ctr_sugars index);
+        val sel_thmss = #sel_thmss (nth ctr_sugars index);
         val collapses = #collapses (nth ctr_sugars index);
         val corec_thms = co_rec_of (nth coiter_thmsss index);
         val disc_corecs = (case co_rec_of (nth disc_coitersss index) of [] => [TrueI]
           | thms => thms);
         val sel_corecss = co_rec_of (nth sel_coiterssss index);
       in
-        map11 mk_ctr_spec ctrs discs selss p_ios q_isss f_isss f_Tsss collapses corec_thms
-          disc_corecs sel_corecss
+        map13 mk_ctr_spec ctrs discs selss p_ios q_isss f_isss f_Tsss discIs sel_thmss collapses
+          corec_thms disc_corecs sel_corecss
       end;
 
     fun mk_spec {T, index, ctr_sugars, co_iterss = coiterss, co_iter_thmsss = coiter_thmsss,
diff -r 657c89169d1a -r f58e289eceba src/HOL/BNF/Tools/bnf_util.ML
--- a/src/HOL/BNF/Tools/bnf_util.ML	Wed Sep 18 19:57:59 2013 +0200
+++ b/src/HOL/BNF/Tools/bnf_util.ML	Wed Sep 18 20:43:55 2013 +0200
@@ -29,6 +29,9 @@
   val map12: ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h -> 'i -> 'j -> 'k -> 'l -> 'm) ->
     'a list -> 'b list -> 'c list -> 'd list -> 'e list -> 'f list -> 'g list -> 'h list ->
     'i list -> 'j list -> 'k list -> 'l list -> 'm list
+  val map13: ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h -> 'i -> 'j -> 'k -> 'l -> 'm -> 'n) ->
+    'a list -> 'b list -> 'c list -> 'd list -> 'e list -> 'f list -> 'g list -> 'h list ->
+    'i list -> 'j list -> 'k list -> 'l list -> 'm list -> 'n list
   val fold_map2: ('a -> 'b -> 'c -> 'd * 'c) -> 'a list -> 'b list -> 'c -> 'd list * 'c
   val fold_map3: ('a -> 'b -> 'c -> 'd -> 'e * 'd) ->
     'a list -> 'b list -> 'c list -> 'd -> 'e list * 'd
@@ -248,6 +251,13 @@
       map12 f x1s x2s x3s x4s x5s x6s x7s x8s x9s x10s x11s x12s
   | map12 _ _ _ _ _ _ _ _ _ _ _ _ _ = raise ListPair.UnequalLengths;
 
+fun map13 _ [] [] [] [] [] [] [] [] [] [] [] [] [] = []
+  | map13 f (x1::x1s) (x2::x2s) (x3::x3s) (x4::x4s) (x5::x5s)
+      (x6::x6s) (x7::x7s) (x8::x8s) (x9::x9s) (x10::x10s) (x11::x11s) (x12::x12s) (x13::x13s) =
+    f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 ::
+      map13 f x1s x2s x3s x4s x5s x6s x7s x8s x9s x10s x11s x12s x13s
+  | map13 _ _ _ _ _ _ _ _ _ _ _ _ _ _ = raise ListPair.UnequalLengths;
+
 fun fold_map2 _ [] [] acc = ([], acc)
   | fold_map2 f (x1::x1s) (x2::x2s) acc =
     let