src/HOL/Tools/Lifting/lifting_term.ML
changeset 48208 ec46b60aa582
parent 48153 9caab698dbe4
child 48237 075d22b3a32f
     1.1 --- a/src/HOL/Tools/Lifting/lifting_term.ML	Wed Apr 04 10:38:04 2012 +0200
     1.2 +++ b/src/HOL/Tools/Lifting/lifting_term.ML	Wed Apr 04 13:41:38 2012 +0200
     1.3 @@ -106,13 +106,13 @@
     1.4      (domain_type abs_type, range_type abs_type)
     1.5    end
     1.6  
     1.7 -fun prove_quot_theorem ctxt (rty, qty) =
     1.8 +fun prove_quot_theorem' ctxt (rty, qty) =
     1.9    case (rty, qty) of
    1.10      (Type (s, tys), Type (s', tys')) =>
    1.11        if s = s'
    1.12        then
    1.13          let
    1.14 -          val args = map (prove_quot_theorem ctxt) (tys ~~ tys')
    1.15 +          val args = map (prove_quot_theorem' ctxt) (tys ~~ tys')
    1.16          in
    1.17            if forall is_id_quot args
    1.18            then
    1.19 @@ -126,7 +126,7 @@
    1.20            val (Type (_, rtys), qty_pat) = quot_thm_rty_qty quot_thm
    1.21            val qtyenv = match ctxt equiv_match_err qty_pat qty
    1.22            val rtys' = map (Envir.subst_type qtyenv) rtys
    1.23 -          val args = map (prove_quot_theorem ctxt) (tys ~~ rtys')
    1.24 +          val args = map (prove_quot_theorem' ctxt) (tys ~~ rtys')
    1.25          in
    1.26            if forall is_id_quot args
    1.27            then
    1.28 @@ -152,22 +152,18 @@
    1.29      Thm.instantiate (ty_inst, []) quot_thm
    1.30    end
    1.31  
    1.32 -fun absrep_fun ctxt (rty, qty) = 
    1.33 +fun prove_quot_theorem ctxt (rty, qty) =
    1.34    let
    1.35      val thy = Proof_Context.theory_of ctxt
    1.36 -    val quot_thm = prove_quot_theorem ctxt (rty, qty)
    1.37 -    val forced_quot_thm = force_qty_type thy qty quot_thm
    1.38 +    val quot_thm = prove_quot_theorem' ctxt (rty, qty)
    1.39    in
    1.40 -    quot_thm_abs forced_quot_thm
    1.41 +    force_qty_type thy qty quot_thm
    1.42    end
    1.43  
    1.44 +fun absrep_fun ctxt (rty, qty) =
    1.45 +  quot_thm_abs (prove_quot_theorem ctxt (rty, qty))
    1.46 +
    1.47  fun equiv_relation ctxt (rty, qty) =
    1.48 -  let
    1.49 -    val thy = Proof_Context.theory_of ctxt
    1.50 -    val quot_thm = prove_quot_theorem ctxt (rty, qty)
    1.51 -    val forced_quot_thm = force_qty_type thy qty quot_thm
    1.52 -  in
    1.53 -    quot_thm_rel forced_quot_thm
    1.54 -  end
    1.55 +  quot_thm_rel (prove_quot_theorem ctxt (rty, qty))
    1.56  
    1.57  end;