--- a/Quot/quotient_term.ML Fri Jan 08 10:08:01 2010 +0100
+++ b/Quot/quotient_term.ML Fri Jan 08 10:39:08 2010 +0100
@@ -215,8 +215,9 @@
map_types (Envir.subst_type ty_inst) trm
end
-fun mk_rel_compose (trm1, trm2) =
- Const (@{const_name "pred_comp"}, dummyT) $ trm1 $ trm2
+fun mk_rel_compose (trm1, trm2) =
+ Const (@{const_name "pred_comp"}, dummyT) $ trm1 $
+ (Const (@{const_name "pred_comp"}, dummyT) $ trm2 $ trm1)
fun get_relmap ctxt s =
let
@@ -288,7 +289,7 @@
val eqv_rel = get_equiv_rel ctxt s'
val eqv_rel' = force_typ ctxt eqv_rel ([rty, rty] ---> @{typ bool})
in
- mk_rel_compose (eqv_rel', result)
+ mk_rel_compose (result, eqv_rel')
end
| _ => HOLogic.eq_const rty
@@ -385,7 +386,7 @@
val subtrm = Abs(x, ty, regularize_trm ctxt (t, t'))
in
if ty = ty' then subtrm
- else mk_babs $ (mk_resp $ equiv_relation ctxt (ty, ty')) $ subtrm
+ else mk_babs $ (mk_resp $ new_equiv_relation ctxt (ty, ty')) $ subtrm
end
| (Const (@{const_name "All"}, ty) $ t, Const (@{const_name "All"}, ty') $ t') =>
@@ -393,7 +394,7 @@
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
in
if ty = ty' then Const (@{const_name "All"}, ty) $ subtrm
- else mk_ball $ (mk_resp $ equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
+ else mk_ball $ (mk_resp $ new_equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
end
| (Const (@{const_name "Ex"}, ty) $ t, Const (@{const_name "Ex"}, ty') $ t') =>
@@ -401,20 +402,20 @@
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
in
if ty = ty' then Const (@{const_name "Ex"}, ty) $ subtrm
- else mk_bex $ (mk_resp $ equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
+ else mk_bex $ (mk_resp $ new_equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
end
| (* equalities need to be replaced by appropriate equivalence relations *)
(Const (@{const_name "op ="}, ty), Const (@{const_name "op ="}, ty')) =>
if ty = ty' then rtrm
- else equiv_relation ctxt (domain_type ty, domain_type ty')
+ else new_equiv_relation ctxt (domain_type ty, domain_type ty')
| (* in this case we just check whether the given equivalence relation is correct *)
(rel, Const (@{const_name "op ="}, ty')) =>
let
val exc = LIFT_MATCH "regularise (relation mismatch)"
val rel_ty = fastype_of rel
- val rel' = equiv_relation ctxt (domain_type rel_ty, domain_type ty')
+ val rel' = new_equiv_relation ctxt (domain_type rel_ty, domain_type ty')
in
if rel' aconv rel then rtrm else raise exc
end