tuned
authorChristian Urban <urbanc@in.tum.de>
Sat, 21 Nov 2009 03:12:50 +0100
changeset 323 31509c8cf72e
parent 322 d741ccea80d3
child 324 bdbb52979790
tuned
QuotMain.thy
--- a/QuotMain.thy	Sat Nov 21 02:53:23 2009 +0100
+++ b/QuotMain.thy	Sat Nov 21 03:12:50 2009 +0100
@@ -1203,8 +1203,6 @@
 (* version with explicit qtrm             *)
 (******************************************)
 
-(* exception for when qtrm and rtrm do not match *)
-
 ML {*
 fun mk_resp_arg lthy (rty, qty) =
 let
@@ -1236,6 +1234,17 @@
 *}
 
 ML {*
+fun trm_lift_error lthy rtrm qtrm =
+let
+  val rtrm_str = quote (Syntax.string_of_term lthy rtrm) 
+  val qtrm_str = quote (Syntax.string_of_term lthy qtrm)
+  val msg = ["quotient theorem", qtrm_str, "and lifted theorem", rtrm_str, "do not match."]
+in
+  raise LIFT_MATCH (space_implode " " msg)
+end 
+*}
+
+ML {*
 (* applies f to the subterm of an abstractions, otherwise to the given term *)
 (* abstracted variables do not have to be treated specially *)
 fun apply_subt f trm1 trm2 =
@@ -1303,16 +1312,16 @@
   | (Free (x, ty), Free (x', ty')) =>
        if x = x' 
        then rtrm 
-       else raise LIFT_MATCH "quotient and lifted theorem do not match"
+       else trm_lift_error lthy rtrm qtrm
   | (Bound i, Bound i') =>
        if i = i' 
        then rtrm 
-       else raise LIFT_MATCH "quotient and lifted theorem do not match"
+       else trm_lift_error lthy rtrm qtrm
   | (Const (s, ty), Const (s', ty')) =>
        if s = s' andalso ty = ty'
        then rtrm
        else rtrm (* FIXME: check correspondence according to definitions *) 
-  | _ => raise LIFT_MATCH "quotient and lifted theorem do not match"
+  | _ => trm_lift_error lthy rtrm qtrm
 *}
 
 ML {*