src/HOL/Tools/BNF/bnf_fp_def_sugar.ML
changeset 62093 bd73a2279fcd
parent 61760 1647bb489522
child 62158 c25c62055180
equal deleted inserted replaced
62092:9ace5f5bae69 62093:bd73a2279fcd
  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;