simplified isar_qualifiers and qs merging
authorsmolkas
Wed, 28 Nov 2012 12:23:44 +0100
changeset 50260 87ddf7eddfc9
parent 50259 9c64a52ae499
child 50261 a1a1685b4ee8
simplified isar_qualifiers and qs merging
src/HOL/Tools/Sledgehammer/sledgehammer_isar_Reconstruct.ML
src/HOL/Tools/Sledgehammer/sledgehammer_reconstruct.ML
src/HOL/Tools/Sledgehammer/sledgehammer_shrink.ML
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_isar_Reconstruct.ML	Wed Nov 28 12:22:17 2012 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_isar_Reconstruct.ML	Wed Nov 28 12:23:44 2012 +0100
@@ -9,7 +9,7 @@
 type label = string * int
 type facts = label list * string list
 
-datatype isar_qualifier = Show | Then | Moreover | Ultimately
+datatype isar_qualifier = Show | Then | Ultimately
 
 datatype isar_step =
   Fix of (string * typ) list |
@@ -43,4 +43,5 @@
            inc (fold (inc o metis_steps_recursive) cases 1)
          | _ => I) proof 0
 
-end
\ No newline at end of file
+
+end
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_reconstruct.ML	Wed Nov 28 12:22:17 2012 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_reconstruct.ML	Wed Nov 28 12:23:44 2012 +0100
@@ -478,7 +478,6 @@
         (Syntax.string_of_typ ctxt) T))
     fun do_label l = if l = no_label then "" else string_for_label l ^ ": "
     fun do_have qs =
-      (if member (op =) qs Moreover then "moreover " else "") ^
       (if member (op =) qs Ultimately then "ultimately " else "") ^
       (if member (op =) qs Then then
          if member (op =) qs Show then "thus" else "hence"
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_shrink.ML	Wed Nov 28 12:22:17 2012 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_shrink.ML	Wed Nov 28 12:23:44 2012 +0100
@@ -59,8 +59,9 @@
   let
     (* proof vector *)
     val proof_vect = proof |> map SOME |> Vector.fromList
-    val n = metis_steps_top_level proof
-    val n_target = Real.fromInt n / isar_shrink |> Real.round
+    val n = Vector.length proof_vect
+    val n_metis = metis_steps_top_level proof
+    val target_n_metis = Real.fromInt n_metis / isar_shrink |> Real.round
 
     (* table for mapping from (top-level-)label to proof position *)
     fun update_table (i, Assume (label, _)) = 
@@ -78,7 +79,7 @@
           @ maps (maps refs) cases
       | refs _ = []
     val refed_by_vect =
-      Vector.tabulate (Vector.length proof_vect, (fn _ => []))
+      Vector.tabulate (n, (fn _ => []))
       |> fold_index (fn (i, step) => fold (update (cons i)) (refs step)) proof
       |> Vector.map rev (* after rev, indices are sorted in ascending order *)
 
@@ -117,15 +118,12 @@
       Vector.map (Lazy.lazy o try_metis preplay_timeout o the) proof_vect
 
     (* Merging *)
-    fun merge (Prove (qs1, label1, _, By_Metis (lfs1, gfs1)))
+    fun merge (Prove (_, label1, _, By_Metis (lfs1, gfs1)))
               (Prove (qs2, label2 , t, By_Metis (lfs2, gfs2))) =
       let
-        val qs = inter (op =) qs1 qs2 (* FIXME: Is this correct? *)
-          |> member (op =) (union (op =) qs1 qs2) Ultimately ? cons Ultimately
-          |> member (op =) qs2 Show ? cons Show
         val ls = remove (op =) label1 lfs2 |> union (op =) lfs1
         val ss = union (op =) gfs1 gfs2
-      in Prove (qs, label2, t, By_Metis (ls, ss)) end
+      in Prove (qs2, label2, t, By_Metis (ls, ss)) end
     fun try_merge metis_time (s1, i) (s2, j) =
       (case get i metis_time |> Lazy.force of
         NONE => (NONE, metis_time)
@@ -148,10 +146,10 @@
 
           end))
 
-    fun merge_steps metis_time proof_vect refed_by cand_tab n' =
+    fun merge_steps metis_time proof_vect refed_by cand_tab n' n_metis' =
       if Inttab.is_empty cand_tab 
-        orelse n' <= n_target 
-        orelse (top_level andalso Vector.length proof_vect<3)
+        orelse n_metis' <= target_n_metis 
+        orelse (top_level andalso n'<3)
       then
         (Vector.foldr
            (fn (NONE, proof) => proof | (SOME s, proof) => s :: proof)
@@ -166,7 +164,7 @@
         in
           case try_merge metis_time (s1, i) (s2, j) of
             (NONE, metis_time) =>
-            merge_steps metis_time proof_vect refed_by cand_tab n'
+            merge_steps metis_time proof_vect refed_by cand_tab n' n_metis'
           | (s, metis_time) => 
           let
             val refs = refs s1
@@ -178,11 +176,11 @@
             val cand_tab = add_list cand_tab new_candidates
             val proof_vect = proof_vect |> replace NONE i |> replace s j
           in
-            merge_steps metis_time proof_vect refed_by cand_tab (n' - 1)
+            merge_steps metis_time proof_vect refed_by cand_tab (n' - 1) (n_metis' - 1)
           end
         end
   in
-    merge_steps metis_time proof_vect refed_by_vect cand_tab n
+    merge_steps metis_time proof_vect refed_by_vect cand_tab n n_metis
   end
   
   fun shrink_proof' top_level ctxt proof =