src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML
changeset 54180 1753c57eb16c
parent 54178 d6dc359426b7
child 54200 064f88a41096
equal deleted inserted replaced
54179:c1daa6e05565 54180:1753c57eb16c
   894 *)
   894 *)
   895 
   895 
   896     val exclss'' = exclss' |> map (map (fn (idx, t) =>
   896     val exclss'' = exclss' |> map (map (fn (idx, t) =>
   897       (idx, (Option.map (Goal.prove lthy [] [] t #> Thm.close_derivation) (excl_tac idx), t))));
   897       (idx, (Option.map (Goal.prove lthy [] [] t #> Thm.close_derivation) (excl_tac idx), t))));
   898     val taut_thmss = map (map (apsnd (the o fst)) o filter (is_some o fst o snd)) exclss'';
   898     val taut_thmss = map (map (apsnd (the o fst)) o filter (is_some o fst o snd)) exclss'';
   899     val (obligation_idxss, goalss) = exclss''
   899     val (goal_idxss, goalss) = exclss''
   900       |> map (map (apsnd (rpair [] o snd)) o filter (is_none o fst o snd))
   900       |> map (map (apsnd (rpair [] o snd)) o filter (is_none o fst o snd))
   901       |> split_list o map split_list;
   901       |> split_list o map split_list;
   902 
   902 
   903     fun prove thmss' def_thms' lthy =
   903     fun prove thmss' def_thms' lthy =
   904       let
   904       let
   905         val def_thms = map (snd o snd) def_thms';
   905         val def_thms = map (snd o snd) def_thms';
   906 
   906 
   907         val exclss' = map (op ~~) (obligation_idxss ~~ thmss');
   907         val exclss' = map (op ~~) (goal_idxss ~~ thmss');
   908         fun mk_exclsss excls n =
   908         fun mk_exclsss excls n =
   909           (excls, map (fn k => replicate k [TrueI] @ replicate (n - k) []) (0 upto n - 1))
   909           (excls, map (fn k => replicate k [TrueI] @ replicate (n - k) []) (0 upto n - 1))
   910           |-> fold (fn ((c, c', _), thm) => nth_map c (nth_map c' (K [thm])));
   910           |-> fold (fn ((c, c', _), thm) => nth_map c (nth_map c' (K [thm])));
   911         val exclssss = (exclss' ~~ taut_thmss |> map (op @), fun_names ~~ corec_specs)
   911         val exclssss = (exclss' ~~ taut_thmss |> map (op @), fun_names ~~ corec_specs)
   912           |-> map2 (fn excls => fn (_, {ctr_specs, ...}) => mk_exclsss excls (length ctr_specs));
   912           |-> map2 (fn excls => fn (_, {ctr_specs, ...}) => mk_exclsss excls (length ctr_specs));