quotient_def.ML
changeset 374 980fdf92a834
parent 365 ba057402ea53
child 389 d67240113f68
--- a/quotient_def.ML	Tue Nov 24 19:09:29 2009 +0100
+++ b/quotient_def.ML	Wed Nov 25 03:45:44 2009 +0100
@@ -31,30 +31,11 @@
 
 fun mk_identity ty = Const (@{const_name "id"}, ty --> ty)
 
-fun ty_strs lthy (ty1, ty2) = 
-  (quote (Syntax.string_of_typ lthy ty1),
-   quote (Syntax.string_of_typ lthy ty2))
-
-fun ty_lift_error1 lthy rty qty =
-let
-  val (rty_str, qty_str) = ty_strs lthy (rty, qty) 
-  val msg = ["quotient type", qty_str, "and lifted type", rty_str, "do not match."]
-in
-  error (space_implode " " msg)
-end
-
-fun ty_lift_error2 lthy rty qty =
-let
-  val (rty_str, qty_str) = ty_strs lthy (rty, qty)   
-  val msg = ["No type variables allowed in", qty_str, "and", rty_str, "."]
-in
-  error (space_implode " " msg)
-end
-
 fun get_fun_aux lthy s fs =
   case (maps_lookup (ProofContext.theory_of lthy) s) of
     SOME info => list_comb (Const (#mapfun info, dummyT), fs)
-  | NONE      => error (space_implode " " ["No map function for type", quote s, "."])
+  | NONE      => raise 
+        (LIFT_MATCH (space_implode " " ["get_fun_aux: no map for type", quote s, "."]))
 
 fun get_const flag lthy _ qty =
 (* FIXME: check here that _ and qty are related *)
@@ -93,9 +74,9 @@
   | (TFree x, TFree x') =>
      if x = x'
      then mk_identity qty 
-     else ty_lift_error1 lthy rty qty
-  | (TVar _, TVar _) => ty_lift_error2 lthy rty qty
-  | _ => ty_lift_error1 lthy rty qty
+     else raise (LIFT_MATCH "get_fun")
+  | (TVar _, TVar _) => raise (LIFT_MATCH "get_fun")
+  | _ => raise (LIFT_MATCH "get_fun")
 
 fun make_def qconst_bname qty mx attr rhs lthy =
 let