diff -r b66d754bf1c2 -r 1ae5afcddcd4 Attic/Quot/quotient_term.ML --- 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