avoid handle _;
authorwenzelm
Thu, 15 Nov 2001 18:15:32 +0100
changeset 12203 571d9c288640
parent 12202 af10de5ec7cc
child 12204 98115606ee42
avoid handle _;
src/ZF/Datatype.ML
src/ZF/Tools/primrec_package.ML
--- a/src/ZF/Datatype.ML	Thu Nov 15 18:15:13 2001 +0100
+++ b/src/ZF/Datatype.ML	Thu Nov 15 18:15:32 2001 +0100
@@ -71,10 +71,12 @@
        val (lhs,rhs) = FOLogic.dest_eq old
        val (lhead, largs) = strip_comb lhs
        and (rhead, rargs) = strip_comb rhs
-       val lname = #1 (dest_Const lhead)
-       and rname = #1 (dest_Const rhead)
+       val lname = #1 (dest_Const lhead) handle TERM _ => raise Match;
+       val rname = #1 (dest_Const rhead) handle TERM _ => raise Match;
        val lcon_info = the (Symtab.lookup (ConstructorsData.get_sg sg, lname))
-       and rcon_info = the (Symtab.lookup (ConstructorsData.get_sg sg, rname))
+         handle Library.OPTION => raise Match;
+       val rcon_info = the (Symtab.lookup (ConstructorsData.get_sg sg, rname))
+         handle Library.OPTION => raise Match;
        val new = 
            if #big_rec_name lcon_info = #big_rec_name rcon_info 
                andalso not (null (#free_iffs lcon_info)) then
@@ -87,10 +89,11 @@
        val goal = Logic.mk_equals (old, new)
        val thm = Tactic.prove sg [] [] goal (fn _ => rtac iff_reflection 1 THEN
            simp_tac (datatype_ss addsimps #free_iffs lcon_info) 1)
-         handle ERROR =>
-         error ("data_free simproc:\nfailed to prove " ^ Sign.string_of_term sg goal)
+         handle ERROR_MESSAGE msg =>
+         (warning (msg ^ "\ndata_free simproc:\nfailed to prove " ^ Sign.string_of_term sg goal);
+          raise Match)
    in Some thm end
-   handle _ => None;
+   handle Match => None;
 
 
  val conv = 
--- a/src/ZF/Tools/primrec_package.ML	Thu Nov 15 18:15:13 2001 +0100
+++ b/src/ZF/Tools/primrec_package.ML	Thu Nov 15 18:15:32 2001 +0100
@@ -41,11 +41,11 @@
   let
     val (lhs, rhs) =
         if null (term_vars eq) then
-            dest_eqn eq handle _ => raise RecError "not a proper equation"
+            dest_eqn eq handle TERM _ => raise RecError "not a proper equation"
         else raise RecError "illegal schematic variable(s)";
 
     val (recfun, args) = strip_comb lhs;
-    val (fname, ftype) = dest_Const recfun handle _ =>
+    val (fname, ftype) = dest_Const recfun handle TERM _ =>
       raise RecError "function is not declared as constant in theory";
 
     val (ls_frees, rest)  = take_prefix is_Free args;
@@ -55,15 +55,15 @@
       if null middle then raise RecError "constructor missing"
       else strip_comb (hd middle);
     val (cname, _) = dest_Const constr
-      handle _ => raise RecError "ill-formed constructor";
+      handle TERM _ => raise RecError "ill-formed constructor";
     val con_info = the (Symtab.lookup (ConstructorsData.get thy, cname))
-      handle _ =>
+      handle Library.OPTION =>
       raise RecError "cannot determine datatype associated with function"
 
     val (ls, cargs, rs) = (map dest_Free ls_frees,
                            map dest_Free cargs_frees,
                            map dest_Free rs_frees)
-      handle _ => raise RecError "illegal argument in pattern";
+      handle TERM _ => raise RecError "illegal argument in pattern";
     val lfrees = ls @ rs @ cargs;
 
     (*Constructor, frees to left of pattern, pattern variables,