# HG changeset patch
# User blanchet
# Date 1344283937 -7200
# Node ID a89b83204c24bfb37346f256de0a0102bfd965cd
# Parent  2585042b1a307c25b6dc1eae2d245167ebaa8938
optimized saving

diff -r 2585042b1a30 -r a89b83204c24 src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Mon Aug 06 21:11:42 2012 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Mon Aug 06 22:12:17 2012 +0200
@@ -425,9 +425,9 @@
 
 fun wipe_out_file file = (try (File.rm o Path.explode) file; ())
 
-fun write_file heading (xs, f) file =
+fun write_file banner (xs, f) file =
   let val path = Path.explode file in
-    File.write path heading;
+    case banner of SOME s => File.write path s | NONE => ();
     xs |> chunk_list 500
        |> List.app (File.append path o space_implode "" o map f)
   end
@@ -462,8 +462,8 @@
       if overlord then ()
       else List.app wipe_out_file [err_file, sugg_file, cmd_file]
   in
-    write_file "" ([], K "") sugg_file;
-    write_file "" write_cmds cmd_file;
+    write_file (SOME "") ([], K "") sugg_file;
+    write_file (SOME "") write_cmds cmd_file;
     trace_msg ctxt (fn () => "Running " ^ command);
     with_cleanup clean_up run_on ()
   end
@@ -543,9 +543,9 @@
   string_of_int (length (Graph.minimals G)) ^ " minimal, " ^
   string_of_int (length (Graph.maximals G)) ^ " maximal"
 
-type mash_state = {fact_G : unit Graph.T}
+type mash_state = {fact_G : unit Graph.T, dirty : string list option}
 
-val empty_state = {fact_G = Graph.empty}
+val empty_state = {fact_G = Graph.empty, dirty = SOME []}
 
 local
 
@@ -573,23 +573,34 @@
          in
            trace_msg ctxt (fn () =>
                "Loaded fact graph (" ^ graph_info fact_G ^ ")");
-           {fact_G = fact_G}
+           {fact_G = fact_G, dirty = SOME []}
          end
        | _ => empty_state)
     end
 
-fun save ctxt {fact_G} =
-  let
-    fun str_of_entry (name, parents, kind) =
-      str_of_proof_kind kind ^ " " ^ escape_meta name ^ ": " ^
-      escape_metas parents ^ "\n"
-    fun append_entry (name, (kind, (parents, _))) =
-      cons (name, Graph.Keys.dest parents, kind)
-    val entries = [] |> Graph.fold append_entry fact_G
-  in
-    write_file (version ^ "\n") (entries, str_of_entry) (mash_state_file ());
-    trace_msg ctxt (fn () => "Saved fact graph (" ^ graph_info fact_G ^ ")")
-  end
+fun save _ (state as {dirty = SOME [], ...}) = state
+  | save ctxt {fact_G, dirty} =
+    let
+      fun str_of_entry (name, parents, kind) =
+        str_of_proof_kind kind ^ " " ^ escape_meta name ^ ": " ^
+        escape_metas parents ^ "\n"
+      fun append_entry (name, (kind, (parents, _))) =
+        cons (name, Graph.Keys.dest parents, kind)
+      val (banner, entries) =
+        case dirty of
+          SOME names =>
+          (NONE, fold (append_entry o Graph.get_entry fact_G) names [])
+        | NONE => (SOME (version ^ "\n"), Graph.fold append_entry fact_G [])
+    in
+      write_file banner (entries, str_of_entry) (mash_state_file ());
+      trace_msg ctxt (fn () =>
+          "Saved fact graph (" ^ graph_info fact_G ^
+          (case dirty of
+             SOME dirty =>
+             "; " ^ string_of_int (length dirty) ^ " dirty fact(s)"
+           | _ => "") ^  ")");
+      {fact_G = fact_G, dirty = SOME []}
+    end
 
 val global_state =
   Synchronized.var "Sledgehammer_MaSh.global_state" (false, empty_state)
@@ -597,7 +608,7 @@
 in
 
 fun mash_map ctxt f =
-  Synchronized.change global_state (load ctxt ##> (f #> tap (save ctxt)))
+  Synchronized.change global_state (load ctxt ##> (f #> save ctxt))
 
 fun mash_peek ctxt f =
   Synchronized.change_result global_state (load ctxt #> `snd #>> f)
@@ -666,7 +677,7 @@
   let
     val thy = Proof_Context.theory_of ctxt
     val (fact_G, suggs) =
-      mash_peek ctxt (fn {fact_G} =>
+      mash_peek ctxt (fn {fact_G, ...} =>
           if Graph.is_empty fact_G then
             (fact_G, [])
           else
@@ -736,7 +747,7 @@
           val feats = features_of ctxt prover thy (Local, General) [t]
           val deps = used_ths |> map nickname_of
         in
-          mash_peek ctxt (fn {fact_G} =>
+          mash_peek ctxt (fn {fact_G, ...} =>
               let val parents = maximal_in_graph fact_G facts in
                 mash_ADD ctxt overlord [(name, parents, feats, deps)]
               end);
@@ -755,7 +766,7 @@
     val timer = Timer.startRealTimer ()
     fun next_commit_time () =
       Time.+ (Timer.checkRealTimer timer, commit_timeout)
-    val {fact_G} = mash_get ctxt
+    val {fact_G, ...} = mash_get ctxt
     val (old_facts, new_facts) =
       facts |> List.partition (is_fact_in_graph fact_G)
             ||> sort (thm_ord o pairself snd)
@@ -782,17 +793,22 @@
           else
             isar_dependencies_of all_names th
         fun do_commit [] [] [] state = state
-          | do_commit adds reps flops {fact_G} =
+          | do_commit adds reps flops {fact_G, dirty} =
             let
+              val was_empty = Graph.is_empty fact_G
               val (adds, fact_G) =
                 ([], fact_G) |> fold (add_wrt_fact_graph ctxt) adds
               val (reps, fact_G) =
                 ([], fact_G) |> fold (reprove_wrt_fact_graph ctxt) reps
               val fact_G = fact_G |> fold flop_wrt_fact_graph flops
+              val dirty =
+                case (was_empty, dirty, reps) of
+                  (false, SOME names, []) => SOME (map #1 adds @ names)
+                | _ => NONE
             in
               mash_ADD ctxt overlord (rev adds);
               mash_REPROVE ctxt overlord reps;
-              {fact_G = fact_G}
+              {fact_G = fact_G, dirty = dirty}
             end
         fun commit last adds reps flops =
           (if debug andalso auto_level = 0 then