1281 |
1281 |
1282 fun define_co_rec_as fp Cs fpT b rhs lthy0 = |
1282 fun define_co_rec_as fp Cs fpT b rhs lthy0 = |
1283 let |
1283 let |
1284 val thy = Proof_Context.theory_of lthy0; |
1284 val thy = Proof_Context.theory_of lthy0; |
1285 |
1285 |
1286 val maybe_conceal_def_binding = Thm.def_binding |
|
1287 #> not (Config.get lthy0 bnf_note_all) ? Binding.concealed; |
|
1288 |
|
1289 val ((cst, (_, def)), (lthy', lthy)) = lthy0 |
1286 val ((cst, (_, def)), (lthy', lthy)) = lthy0 |
1290 |> Local_Theory.open_target |> snd |
1287 |> Local_Theory.open_target |> snd |
1291 |> Local_Theory.define ((b, NoSyn), ((maybe_conceal_def_binding b, []), rhs)) |
1288 |> Local_Theory.define |
|
1289 ((b, NoSyn), ((Thm.make_def_binding (Config.get lthy0 bnf_internals) b, []), rhs)) |
1292 ||> `Local_Theory.close_target; |
1290 ||> `Local_Theory.close_target; |
1293 |
1291 |
1294 val phi = Proof_Context.export_morphism lthy lthy'; |
1292 val phi = Proof_Context.export_morphism lthy lthy'; |
1295 |
1293 |
1296 val cst' = mk_co_rec thy fp Cs fpT (Morphism.term phi cst); |
1294 val cst' = mk_co_rec thy fp Cs fpT (Morphism.term phi cst); |
2199 |
2197 |
2200 val ctr_rhss = |
2198 val ctr_rhss = |
2201 map2 (fn k => fn xs => fold_rev Term.lambda xs (ctor $ mk_absumprod ctr_absT abs n k xs)) |
2199 map2 (fn k => fn xs => fold_rev Term.lambda xs (ctor $ mk_absumprod ctr_absT abs n k xs)) |
2202 ks xss; |
2200 ks xss; |
2203 |
2201 |
2204 val maybe_conceal_def_binding = Thm.def_binding |
|
2205 #> not (Config.get no_defs_lthy bnf_note_all) ? Binding.concealed; |
|
2206 |
|
2207 val ((raw_ctrs, raw_ctr_defs), (lthy', lthy)) = no_defs_lthy |
2202 val ((raw_ctrs, raw_ctr_defs), (lthy', lthy)) = no_defs_lthy |
2208 |> Local_Theory.open_target |> snd |
2203 |> Local_Theory.open_target |> snd |
2209 |> apfst split_list o @{fold_map 3} (fn b => fn mx => fn rhs => |
2204 |> apfst split_list o @{fold_map 3} (fn b => fn mx => fn rhs => |
2210 Local_Theory.define ((b, mx), ((maybe_conceal_def_binding b, []), rhs)) #>> apsnd snd) |
2205 Local_Theory.define |
2211 ctr_bindings ctr_mixfixes ctr_rhss |
2206 ((b, mx), ((Thm.make_def_binding (Config.get no_defs_lthy bnf_internals) b, []), rhs)) |
|
2207 #>> apsnd snd) ctr_bindings ctr_mixfixes ctr_rhss |
2212 ||> `Local_Theory.close_target; |
2208 ||> `Local_Theory.close_target; |
2213 |
2209 |
2214 val phi = Proof_Context.export_morphism lthy lthy'; |
2210 val phi = Proof_Context.export_morphism lthy lthy'; |
2215 |
2211 |
2216 val ctr_defs = map (Morphism.thm phi) raw_ctr_defs; |
2212 val ctr_defs = map (Morphism.thm phi) raw_ctr_defs; |