Quot/quotient_term.ML
changeset 1077 44461d5615eb
parent 1075 b2f32114e8a6
child 1078 f4da25147389
--- a/Quot/quotient_term.ML	Fri Feb 05 15:17:21 2010 +0100
+++ b/Quot/quotient_term.ML	Sat Feb 06 10:04:56 2010 +0100
@@ -473,18 +473,14 @@
          else mk_bex $ (mk_resp $ equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
        end
 
-  | (Const (@{const_name "Ex1"}, ty) $ 
-      (Abs (n, _,
-        (Const (@{const_name "op &"}, _) $ 
-          (Const (@{const_name "op :"}, _) $ _ $ (Const (@{const_name "Respects"}, _) $ resrel)) $ 
-          (t $ _)
-        )
-      )), Const (@{const_name "Ex1"}, ty') $ t') =>
+  | (Const (@{const_name "Ex1"}, ty) $ (Abs (_, _,
+      (Const (@{const_name "op &"}, _) $ (Const (@{const_name "op :"}, _) $ _ $ 
+        (Const (@{const_name "Respects"}, _) $ resrel)) $ (t $ _)))), 
+     Const (@{const_name "Ex1"}, ty') $ t') =>
        let
-         val t = incr_boundvars (~1) t
-         val subtrm = apply_subt (regularize_trm ctxt) (t, t')
+         val t_ = incr_boundvars (~1) t
+         val subtrm = apply_subt (regularize_trm ctxt) (t_, t')
          val needrel = equiv_relation_chk ctxt (qnt_typ ty, qnt_typ ty')
-         val _ = tracing "bla"
        in
          if resrel <> needrel
          then term_mismatch "regularize (Bex1)" ctxt resrel needrel
@@ -689,19 +685,27 @@
   inj_repabs_trm ctxt (rtrm, qtrm) 
   |> Syntax.check_term ctxt
 
-(*** Translating the goal automatically
+
+
+(*** Wrapper for transforming an rthm into a qthm ***)
 
+(*
 Finds subterms of a term that can be lifted and:
+
 * replaces subterms matching lifted constants by the lifted constants
+
 * replaces equivalence relations by equalities
+
 * In constants, frees and schematic variables replaces
-  subtypes matching lifted types by those types *)
+  subtypes matching lifted types by those types 
+*)
 
 fun subst_ty thy ty (rty, qty) r =
   if r <> NONE then r else
   case try (Sign.typ_match thy (ty, rty)) Vartab.empty of
     SOME inst => SOME (Envir.subst_type inst qty)
   | NONE => NONE
+
 fun subst_tys thy substs ty =
   case fold (subst_ty thy ty) substs NONE of
     SOME ty => ty
@@ -715,6 +719,7 @@
     case try (Pattern.match thy (t, rt)) (Vartab.empty, Vartab.empty) of
       SOME inst => SOME (Envir.subst_term inst qt)
     | NONE => NONE;
+
 fun subst_trms thy substs t = fold (subst_trm thy t) substs NONE
 
 fun get_ty_trm_substs ctxt =
@@ -727,7 +732,7 @@
   fun rel_eq rel = HOLogic.eq_const (subst_tys thy ty_substs (domain_type (fastype_of rel)))
   val rel_substs = map (fn ri => (#equiv_rel ri, rel_eq (#equiv_rel ri))) quot_infos
 in
-  (ty_substs, (const_substs @ rel_substs))
+  (ty_substs, const_substs @ rel_substs)
 end
 
 fun quotient_lift_all ctxt t =
@@ -745,7 +750,7 @@
             val (y, s') = Term.dest_abs (a, ty, s)
             val nty = subst_tys thy ty_substs ty
           in
-          Abs(y, nty, abstract_over (Free (y, nty), (lift_aux s')))
+            Abs(y, nty, abstract_over (Free (y, nty), lift_aux s'))
           end
       | Free(n, ty) => Free(n, subst_tys thy ty_substs ty)
       | Var(n, ty) => Var(n, subst_tys thy ty_substs ty)