src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML
changeset 54154 3fc041880014
parent 54153 67487a607ce2
child 54155 b964fad0cbbd
equal deleted inserted replaced
54153:67487a607ce2 54154:3fc041880014
   281         hd x |> #left_args |> length) funs_data;
   281         hd x |> #left_args |> length) funs_data;
   282   in
   282   in
   283     (recs, ctr_poss)
   283     (recs, ctr_poss)
   284     |-> map2 (fn recx => fn ctr_pos => list_comb (recx, rec_args) |> permute_args ctr_pos)
   284     |-> map2 (fn recx => fn ctr_pos => list_comb (recx, rec_args) |> permute_args ctr_pos)
   285     |> Syntax.check_terms lthy
   285     |> Syntax.check_terms lthy
   286     |> map3 (fn b => fn mx => fn t => ((b, mx), ((Binding.map_name Thm.def_name b, []), t))) bs mxs
   286     |> map3 (fn b => fn mx => fn t =>
       
   287       ((b, mx), ((Binding.conceal (Binding.map_name Thm.def_name b), []), t))) bs mxs
   287   end;
   288   end;
   288 
   289 
   289 fun find_rec_calls has_call (eqn_data : eqn_data) =
   290 fun find_rec_calls has_call (eqn_data : eqn_data) =
   290   let
   291   let
   291     fun find (Abs (_, _, b)) ctr_arg = find b ctr_arg
   292     fun find (Abs (_, _, b)) ctr_arg = find b ctr_arg
   775   in
   776   in
   776     map (list_comb o rpair corec_args) corecs
   777     map (list_comb o rpair corec_args) corecs
   777     |> map2 (fn Ts => fn t => if length Ts = 0 then t $ HOLogic.unit else t) arg_Tss
   778     |> map2 (fn Ts => fn t => if length Ts = 0 then t $ HOLogic.unit else t) arg_Tss
   778     |> map2 currys arg_Tss
   779     |> map2 currys arg_Tss
   779     |> Syntax.check_terms lthy
   780     |> Syntax.check_terms lthy
   780     |> map3 (fn b => fn mx => fn t => ((b, mx), ((Binding.map_name Thm.def_name b, []), t))) bs mxs
   781     |> map3 (fn b => fn mx => fn t =>
       
   782       ((b, mx), ((Binding.conceal (Binding.map_name Thm.def_name b), []), t))) bs mxs
   781     |> rpair exclss'
   783     |> rpair exclss'
   782   end;
   784   end;
   783 
   785 
   784 fun mk_real_disc_eqns fun_binding arg_Ts ({ctr_specs, ...} : corec_spec)
   786 fun mk_real_disc_eqns fun_binding arg_Ts ({ctr_specs, ...} : corec_spec)
   785     (sel_eqns : coeqn_data_sel list) (disc_eqns : coeqn_data_disc list) =
   787     (sel_eqns : coeqn_data_sel list) (disc_eqns : coeqn_data_disc list) =