src/HOL/Tools/Transfer/transfer_bnf.ML
changeset 59580 cbc38731d42f
parent 59498 50b60f501b05
child 59582 0fbed69ff081
equal deleted inserted replaced
59579:d8fff0b94c53 59580:cbc38731d42f
   341     val old_lthy = lthy
   341     val old_lthy = lthy
   342     val (As, lthy) = mk_TFrees' (sorts_of_fp fp_sugar) lthy
   342     val (As, lthy) = mk_TFrees' (sorts_of_fp fp_sugar) lthy
   343     val predTs = map mk_pred1T As
   343     val predTs = map mk_pred1T As
   344     val (preds, lthy) = mk_Frees "P" predTs lthy
   344     val (preds, lthy) = mk_Frees "P" predTs lthy
   345     val args = map mk_eq_onp preds
   345     val args = map mk_eq_onp preds
   346     val cTs = map (SOME o certifyT lthy) (maps (replicate 2) As)
   346     val cTs = map (SOME o Proof_Context.ctyp_of lthy) (maps (replicate 2) As)
   347     val cts = map (SOME o certify lthy) args
   347     val cts = map (SOME o Proof_Context.cterm_of lthy) args
   348     fun get_rhs thm = thm |> concl_of |> HOLogic.dest_Trueprop |> HOLogic.dest_eq |> snd
   348     fun get_rhs thm = thm |> concl_of |> HOLogic.dest_Trueprop |> HOLogic.dest_eq |> snd
   349     fun is_eqn thm = can get_rhs thm
   349     fun is_eqn thm = can get_rhs thm
   350     fun rel2pred_massage thm =
   350     fun rel2pred_massage thm =
   351       let
   351       let
   352         val live_step = @{lemma "x = y \<Longrightarrow> (eq_onp P a a \<and> x) = (P a \<and> y)" by (simp only: eq_onp_same_args)}
   352         val live_step = @{lemma "x = y \<Longrightarrow> (eq_onp P a a \<and> x) = (P a \<and> y)" by (simp only: eq_onp_same_args)}