src/HOL/Tools/Sledgehammer/sledgehammer_filter_mash.ML
changeset 49316 e5c5037a3104
parent 49314 5e5c6616f0fe
child 49317 6cf5e58f1185
     1.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_filter_mash.ML	Wed Jul 18 08:44:03 2012 +0200
     1.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_filter_mash.ML	Wed Jul 18 08:44:03 2012 +0200
     1.3 @@ -55,21 +55,27 @@
     1.4  open Sledgehammer_Filter_Iter
     1.5  open Sledgehammer_Provers
     1.6  
     1.7 +val mash_dir = "mash"
     1.8 +val model_file = "model"
     1.9 +val state_file = "state"
    1.10 +
    1.11 +fun mash_path file = getenv "ISABELLE_HOME_USER" ^ "/" ^ mash_dir ^ "/" ^ file
    1.12 +
    1.13  
    1.14  (*** Low-level communication with MaSh ***)
    1.15  
    1.16  fun mash_RESET () =
    1.17 -  tracing "MaSh RESET"
    1.18 +  warning "MaSh RESET"
    1.19  
    1.20 -fun mash_ADD fact (access, feats, deps) =
    1.21 -  tracing ("MaSh ADD " ^ fact ^ ": " ^ space_implode " " access ^ "; " ^
    1.22 +fun mash_ADD fact access feats deps =
    1.23 +  warning ("MaSh ADD " ^ fact ^ ": " ^ space_implode " " access ^ "; " ^
    1.24             space_implode " " feats ^ "; " ^ space_implode " " deps)
    1.25  
    1.26  fun mash_DEL fact =
    1.27 -  tracing ("MaSh DEL " ^ fact)
    1.28 +  warning ("MaSh DEL " ^ fact)
    1.29  
    1.30 -fun mash_SUGGEST fact (access, feats) =
    1.31 -  tracing ("MaSh SUGGEST " ^ fact ^ ": " ^ space_implode " " access ^ "; " ^
    1.32 +fun mash_SUGGEST access feats =
    1.33 +  warning ("MaSh SUGGEST " ^ space_implode " " access ^ "; " ^
    1.34             space_implode " " feats)
    1.35  
    1.36  
    1.37 @@ -371,18 +377,82 @@
    1.38  
    1.39  (*** High-level communication with MaSh ***)
    1.40  
    1.41 -fun mash_reset () = ()
    1.42 +type mash_state =
    1.43 +  {completed_thys : unit Symtab.table,
    1.44 +   thy_facts : string list Symtab.table}
    1.45  
    1.46 -fun mash_can_suggest_facts () = true
    1.47 +val mash_zero =
    1.48 +  {completed_thys = Symtab.empty,
    1.49 +   thy_facts = Symtab.empty}
    1.50 +
    1.51 +local
    1.52 +
    1.53 +fun mash_load (state as (true, _)) = state
    1.54 +  | mash_load _ =
    1.55 +    (true,
    1.56 +     case mash_path state_file |> Path.explode |> File.read_lines of
    1.57 +       [] => mash_zero
    1.58 +     | comp_line :: facts_lines =>
    1.59 +       let
    1.60 +         fun comp_thys_of_line comp_line =
    1.61 +           Symtab.make (comp_line |> space_explode " " |> map (rpair ()))
    1.62 +         fun add_facts_line line =
    1.63 +           case space_explode " " line of
    1.64 +             thy :: facts => Symtab.update_new (thy, facts)
    1.65 +           | _ => I (* shouldn't happen *)
    1.66 +       in
    1.67 +         {completed_thys = comp_thys_of_line comp_line,
    1.68 +          thy_facts = fold add_facts_line facts_lines Symtab.empty}
    1.69 +       end)
    1.70 +
    1.71 +fun mash_save ({completed_thys, thy_facts} : mash_state) =
    1.72 +  let
    1.73 +    val path = mash_path state_file |> Path.explode
    1.74 +    val comp_line = (completed_thys |> Symtab.keys |> space_implode " ") ^ "\n"
    1.75 +    fun fact_line_for (thy, facts) = space_implode " " (thy :: facts) ^ "\n"
    1.76 +  in
    1.77 +    File.write path comp_line;
    1.78 +    Symtab.fold (fn thy_fact => fn () =>
    1.79 +                    File.append path (fact_line_for thy_fact)) thy_facts
    1.80 +  end
    1.81 +
    1.82 +val state =
    1.83 +  Synchronized.var "Sledgehammer_Filter_MaSh.state" (false, mash_zero)
    1.84 +
    1.85 +in
    1.86 +
    1.87 +fun mash_change f =
    1.88 +  Synchronized.change state (apsnd (tap mash_save o f) o mash_load)
    1.89 +
    1.90 +fun mash_value () = Synchronized.change_result state (`snd o mash_load)
    1.91 +
    1.92 +end
    1.93 +
    1.94 +fun mash_reset () = mash_change (fn _ => (mash_RESET (); mash_zero))
    1.95 +
    1.96 +fun mash_can_suggest_facts () =
    1.97 +  not (Symtab.is_empty (#thy_facts (mash_value ())))
    1.98  
    1.99  fun mash_suggest_facts ctxt params prover max_facts hyp_ts concl_t facts =
   1.100 -  (facts, [])
   1.101 +  let
   1.102 +    val access = []
   1.103 +    val feats = []
   1.104 +    val suggs = mash_SUGGEST access feats
   1.105 +  in (facts, []) end
   1.106  
   1.107 -fun mash_can_learn_thy thy = true
   1.108 +fun mash_can_learn_thy thy =
   1.109 +  not (Symtab.defined (#completed_thys (mash_value ()))
   1.110 +                      (Context.theory_name thy))
   1.111  
   1.112  fun mash_learn_thy thy timeout = ()
   1.113  
   1.114  fun mash_learn_proof thy t ths = ()
   1.115 +(*###
   1.116 +  let
   1.117 +  in
   1.118 +    mash_ADD
   1.119 +  end
   1.120 +*)
   1.121  
   1.122  fun relevant_facts ctxt params prover max_facts
   1.123          ({add, only, ...} : fact_override) hyp_ts concl_t facts =