Put relation_error as a separate function.
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Wed, 13 Jan 2010 16:23:32 +0100
changeset 865 5c6d76c3ba5c
parent 864 999870716cc8
child 866 f537d570fff8
Put relation_error as a separate function.
Quot/quotient_term.ML
--- a/Quot/quotient_term.ML	Wed Jan 13 16:14:02 2010 +0100
+++ b/Quot/quotient_term.ML	Wed Jan 13 16:23:32 2010 +0100
@@ -373,6 +373,17 @@
     (Abs (x, T, t), Abs (_ , _, t')) => Abs (x, T, f (t, t'))
   | _ => f (trm1, trm2)
 
+fun relation_error ctxt r1 r2 =
+let
+  val r1s = Syntax.string_of_term ctxt r1
+  val r2s = Syntax.string_of_term ctxt r2
+  val r1t = Syntax.string_of_typ ctxt (fastype_of r1)
+  val r2t = Syntax.string_of_typ ctxt (fastype_of r2)
+in
+  raise LIFT_MATCH ("regularise (relation mismatch)\n[" ^
+  r1s ^ " :: " ^ r1t ^ "]\n[" ^ r2s ^ " :: " ^ r2t ^ "]")
+end
+
 (* the major type of All and Ex quantifiers *)
 fun qnt_typ ty = domain_type (domain_type ty)
 
@@ -416,18 +427,12 @@
 
   | (* in this case we just check whether the given equivalence relation is correct *) 
     (rel, Const (@{const_name "op ="}, ty')) =>
-       let 
-         (* FIXME: better exception handling *)  
-         fun exc rel rel' = LIFT_MATCH ("regularise (relation mismatch)\n[" ^
-           Syntax.string_of_term ctxt rel ^ " :: " ^
-           Syntax.string_of_typ ctxt (fastype_of rel) ^ "]\n[" ^
-           Syntax.string_of_term ctxt rel' ^ " :: " ^
-           Syntax.string_of_typ ctxt (fastype_of rel') ^ "]")
+       let
          val rel_ty = fastype_of rel
          val rel' = equiv_relation_chk ctxt (domain_type rel_ty, domain_type ty') 
-       in 
-         if rel' aconv rel then rtrm else raise (exc rel rel')
-       end  
+       in
+         if rel' aconv rel then rtrm else relation_error ctxt rel rel'
+       end
 
   | (_, Const _) =>
        let