src/HOL/BNF/Tools/bnf_gfp_rec_sugar.ML
changeset 54958 4933165fd112
parent 54956 80a1931267ce
child 54959 30ded82ff806
equal deleted inserted replaced
54957:99eebac5fcb3 54958:4933165fd112
   848       disc_eqns
   848       disc_eqns
   849     else
   849     else
   850       let
   850       let
   851         val n = 0 upto length ctr_specs
   851         val n = 0 upto length ctr_specs
   852           |> the o find_first (fn idx => not (exists (curry (op =) idx o #ctr_no) disc_eqns));
   852           |> the o find_first (fn idx => not (exists (curry (op =) idx o #ctr_no) disc_eqns));
       
   853         val {ctr, disc, ...} = nth ctr_specs n;
   853         val fun_args = (try (#fun_args o hd) disc_eqns, try (#fun_args o hd) sel_eqns)
   854         val fun_args = (try (#fun_args o hd) disc_eqns, try (#fun_args o hd) sel_eqns)
   854           |> the_default (map (curry Free Name.uu) arg_Ts) o merge_options;
   855           |> the_default (map (curry Free Name.uu) arg_Ts) o merge_options;
   855         val sel_eqn_opt =
   856         val sel_eqn_opt = find_first (equal ctr o #ctr) sel_eqns;
   856           find_first (curry (op =) (Binding.name_of fun_binding) o #fun_name) sel_eqns;
       
   857         val extra_disc_eqn = {
   857         val extra_disc_eqn = {
   858           fun_name = Binding.name_of fun_binding,
   858           fun_name = Binding.name_of fun_binding,
   859           fun_T = arg_Ts ---> body_type (fastype_of (#ctr (hd ctr_specs))),
   859           fun_T = arg_Ts ---> body_type (fastype_of (#ctr (hd ctr_specs))),
   860           fun_args = fun_args,
   860           fun_args = fun_args,
   861           ctr = #ctr (nth ctr_specs n),
   861           ctr = ctr,
   862           ctr_no = n,
   862           ctr_no = n,
   863           disc = #disc (nth ctr_specs n),
   863           disc = disc,
   864           prems = maps (s_not_conj o #prems) disc_eqns,
   864           prems = maps (s_not_conj o #prems) disc_eqns,
   865           auto_gen = true,
   865           auto_gen = true,
   866           ctr_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE,
   866           ctr_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE,
   867           code_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE,
   867           code_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE,
   868           eqn_pos = Option.map (curry (op +) 1 o #eqn_pos) sel_eqn_opt |> the_default 1000 (*###*),
   868           eqn_pos = Option.map (curry (op +) 1 o #eqn_pos) sel_eqn_opt |> the_default 1000 (*###*),