another synchronisation
authorChristian Urban <urbanc@in.tum.de>
Mon, 15 Mar 2010 17:52:31 +0100
changeset 1450 1ae5afcddcd4
parent 1449 b66d754bf1c2
child 1451 104bdc0757e9
another synchronisation
Attic/Quot/quotient_tacs.ML
Attic/Quot/quotient_term.ML
--- a/Attic/Quot/quotient_tacs.ML	Mon Mar 15 17:51:35 2010 +0100
+++ b/Attic/Quot/quotient_tacs.ML	Mon Mar 15 17:52:31 2010 +0100
@@ -603,9 +603,9 @@
   val rtrm' = HOLogic.dest_Trueprop rtrm
   val qtrm' = HOLogic.dest_Trueprop qtrm
   val reg_goal = regularize_trm_chk ctxt (rtrm', qtrm')
-    handle (LIFT_MATCH msg) => lift_match_error ctxt msg rtrm qtrm
+    handle (ERROR msg) => lift_match_error ctxt msg rtrm qtrm
   val inj_goal = inj_repabs_trm_chk ctxt (reg_goal, qtrm')
-    handle (LIFT_MATCH msg) => lift_match_error ctxt msg rtrm qtrm
+    handle (ERROR msg) => lift_match_error ctxt msg rtrm qtrm
 in
   Drule.instantiate' []
     [SOME (cterm_of thy rtrm'),
--- a/Attic/Quot/quotient_term.ML	Mon Mar 15 17:51:35 2010 +0100
+++ b/Attic/Quot/quotient_term.ML	Mon Mar 15 17:52:31 2010 +0100
@@ -7,8 +7,6 @@
 
 signature QUOTIENT_TERM =
 sig
-  exception LIFT_MATCH of string
-
   datatype flag = AbsF | RepF
 
   val absrep_fun: flag -> Proof.context -> typ * typ -> term
@@ -65,7 +63,7 @@
 fun get_mapfun ctxt s =
 let
   val thy = ProofContext.theory_of ctxt
-  val exn = LIFT_MATCH ("No map function for type " ^ quote s ^ " found.")
+  val exn = error ("No map function for type " ^ quote s ^ " found.")
   val mapfun = #mapfun (maps_lookup thy s) handle Quotient_Info.NotFound => raise exn
 in
   Const (mapfun, dummyT)
@@ -91,7 +89,7 @@
       TVar _ => mk_Free rty
     | Type (_, []) => mk_identity rty
     | Type (s, tys) => list_comb (get_mapfun ctxt s, map mk_mapfun_aux tys)
-    | _ => raise LIFT_MATCH "mk_mapfun (default)"
+    | _ => raise (error "mk_mapfun (default)")
 in
   fold_rev Term.lambda vs' (mk_mapfun_aux rty)
 end
@@ -102,7 +100,7 @@
 fun get_rty_qty ctxt s =
 let
   val thy = ProofContext.theory_of ctxt
-  val exn = LIFT_MATCH ("No quotient type " ^ quote s ^ " found.")
+  val exn = error ("No quotient type " ^ quote s ^ " found.")
   val qdata = (quotdata_lookup thy s) handle Quotient_Info.NotFound => raise exn
 in
   (#rtyp qdata, #qtyp qdata)
@@ -148,7 +146,7 @@
   val ty_pat_str = Syntax.string_of_typ ctxt ty_pat
   val ty_str = Syntax.string_of_typ ctxt ty
 in
-  raise LIFT_MATCH (space_implode " "
+  raise error (cat_lines
     ["absrep_fun (Types ", quote ty_pat_str, "and", quote ty_str, " do not match.)"])
 end
 
@@ -233,9 +231,9 @@
     | (TFree x, TFree x') =>
         if x = x'
         then mk_identity rty
-        else raise (LIFT_MATCH "absrep_fun (frees)")
+        else raise (error "absrep_fun (frees)")
     | (TVar _, TVar _) => raise (LIFT_MATCH "absrep_fun (vars)")
-    | _ => raise (LIFT_MATCH "absrep_fun (default)")
+    | _ => raise (error "absrep_fun (default)")
 
 fun absrep_fun_chk flag ctxt (rty, qty) =
   absrep_fun flag ctxt (rty, qty)
@@ -270,7 +268,7 @@
 fun get_relmap ctxt s =
 let
   val thy = ProofContext.theory_of ctxt
-  val exn = LIFT_MATCH ("get_relmap (no relation map function found for type " ^ s ^ ")")
+  val exn = error ("get_relmap (no relation map function found for type " ^ s ^ ")")
   val relmap = #relmap (maps_lookup thy s) handle Quotient_Info.NotFound => raise exn
 in
   Const (relmap, dummyT)
@@ -285,7 +283,7 @@
       TVar _ => mk_Free rty
     | Type (_, []) => HOLogic.eq_const rty
     | Type (s, tys) => list_comb (get_relmap ctxt s, map mk_relmap_aux tys)
-    | _ => raise LIFT_MATCH ("mk_relmap (default)")
+    | _ => raise (error "mk_relmap (default)")
 in
   fold_rev Term.lambda vs' (mk_relmap_aux rty)
 end
@@ -293,7 +291,7 @@
 fun get_equiv_rel ctxt s =
 let
   val thy = ProofContext.theory_of ctxt
-  val exn = LIFT_MATCH ("get_quotdata (no quotient found for type " ^ s ^ ")")
+  val exn = error ("get_quotdata (no quotient found for type " ^ s ^ ")")
 in
   #equiv_rel (quotdata_lookup thy s) handle Quotient_Info.NotFound => raise exn
 end
@@ -303,7 +301,7 @@
   val ty_pat_str = Syntax.string_of_typ ctxt ty_pat
   val ty_str = Syntax.string_of_typ ctxt ty
 in
-  raise LIFT_MATCH (space_implode " "
+  raise error (space_implode " "
     ["equiv_relation (Types ", quote ty_pat_str, "and", quote ty_str, " do not match.)"])
 end
 
@@ -410,7 +408,7 @@
   val t1_ty_str = Syntax.string_of_typ ctxt (fastype_of t1)
   val t2_ty_str = Syntax.string_of_typ ctxt (fastype_of t2)
 in
-  raise LIFT_MATCH (cat_lines [str, t1_str ^ "::" ^ t1_ty_str, t2_str ^ "::" ^ t2_ty_str])
+  raise error (cat_lines [str, t1_str ^ "::" ^ t1_ty_str, t2_str ^ "::" ^ t2_ty_str])
 end
 
 (* the major type of All and Ex quantifiers *)
@@ -573,14 +571,14 @@
 
   | (Bound i, Bound i') =>
        if i = i' then rtrm
-       else raise (LIFT_MATCH "regularize (bounds mismatch)")
+       else raise (error "regularize (bounds mismatch)")
 
   | _ =>
        let
          val rtrm_str = Syntax.string_of_term ctxt rtrm
          val qtrm_str = Syntax.string_of_term ctxt qtrm
        in
-         raise (LIFT_MATCH ("regularize failed (default: " ^ rtrm_str ^ "," ^ qtrm_str ^ ")"))
+         raise (error ("regularize failed (default: " ^ rtrm_str ^ "," ^ qtrm_str ^ ")"))
        end
 
 fun regularize_trm_chk ctxt (rtrm, qtrm) =
@@ -628,7 +626,7 @@
   val rtrm_str = Syntax.string_of_term ctxt rtrm
   val qtrm_str = Syntax.string_of_term ctxt qtrm
 in
-  raise LIFT_MATCH (space_implode " " [msg, quote rtrm_str, "and", quote qtrm_str])
+  raise error (space_implode " " [msg, quote rtrm_str, "and", quote qtrm_str])
 end