Quot/quotient_term.ML
changeset 825 970e86082cd7
parent 808 90bde96f5dd1
child 826 e3732ed89dfc
--- 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