diff -r d741ccea80d3 -r 31509c8cf72e 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 {*