(*  Title:      HOL/TPTP/mash_eval.ML

     Author:     Jasmin Blanchette, TU Muenchen

     Copyright   2012

 Evaluate proof suggestions from MaSh (Machine-learning for Sledgehammer).

 *)

 signature MASH_EVAL =

 sig

   type params = Sledgehammer_Provers.params

   val MePoN : string

   val MaSh_IsarN : string

   val MaSh_ProverN : string

   val MeSh_IsarN : string

   val MeSh_ProverN : string

   val IsarN : string

   val evaluate_mash_suggestions :

     Proof.context -> params -> int * int option -> bool -> string list

     -> string option -> string -> string -> string -> string -> string -> string

     -> unit

 end;

 structure MaSh_Eval : MASH_EVAL =

 struct

 open Sledgehammer_Util

 open Sledgehammer_Fact

 open Sledgehammer_MePo

 open Sledgehammer_MaSh

 open Sledgehammer_Provers

 open Sledgehammer_Isar

 val MaSh_IsarN = MaShN ^ "-Isar"

 val MaSh_ProverN = MaShN ^ "-Prover"

 val MeSh_IsarN = MeShN ^ "-Isar"

 val MeSh_ProverN = MeShN ^ "-Prover"

 val IsarN = "Isar"

 fun in_range (from, to) j =

   j >= from andalso (to = NONE orelse j <= the to)

 fun evaluate_mash_suggestions ctxt params range linearize methods prob_dir_name

         mepo_file_name mash_isar_file_name mash_prover_file_name

         mesh_isar_file_name mesh_prover_file_name report_file_name =

   let

     val zeros = [0, 0, 0, 0, 0, 0]

     val report_path = report_file_name |> Path.explode

     val _ = File.write report_path ""

     fun print s = File.append report_path (s ^ "\n")

     val {provers, max_facts, slice, type_enc, lam_trans, timeout, ...} =

       default_params ctxt []

     val prover = hd provers

     val slack_max_facts = generous_max_facts (the max_facts)

     val lines_of = Path.explode #> try File.read_lines #> these

     val file_names =

       [mepo_file_name, mash_isar_file_name, mash_prover_file_name,

        mesh_isar_file_name, mesh_prover_file_name]

     val lines as [mepo_lines, mash_isar_lines, mash_prover_lines,

                   mesh_isar_lines, mesh_prover_lines] =

       map lines_of file_names

     val num_lines = fold (Integer.max o length) lines 0

     fun pad lines = lines @ replicate (num_lines - length lines) ""

     val lines =

       pad mepo_lines ~~ pad mash_isar_lines ~~ pad mash_prover_lines ~~

       pad mesh_isar_lines ~~ pad mesh_prover_lines

     val css = clasimpset_rule_table_of ctxt

     val facts = all_facts ctxt true false Symtab.empty [] [] css

     val name_tabs = build_name_tables nickname_of_thm facts

     fun with_index facts s = (find_index (curry (op =) s) facts + 1, s)

     fun index_str (j, s) = s ^ "@" ^ string_of_int j

     val str_of_method = enclose "  " ": "

     fun str_of_result method facts ({outcome, run_time, used_facts, ...}

                                      : prover_result) =

       let val facts = facts |> map (fst o fst) in

         str_of_method method ^

         (if is_none outcome then

            "Success (" ^ ATP_Util.string_from_time run_time ^ "): " ^

            (used_facts |> map (with_index facts o fst)

                        |> sort (int_ord o pairself fst)

                        |> map index_str

                        |> space_implode " ") ^

            (if length facts < the max_facts then

               " (of " ^ string_of_int (length facts) ^ ")"

             else

               "")

          else

            "Failure: " ^

            (facts |> take (the max_facts) |> tag_list 1

                   |> map index_str

                   |> space_implode " "))

       end

     fun solve_goal (j, ((((mepo_line, mash_isar_line), mash_prover_line),

                          mesh_isar_line), mesh_prover_line)) =

       if in_range range j then

         let

           val get_suggs = extract_suggestions ##> take slack_max_facts

           val (name1, mepo_suggs) = get_suggs mepo_line

           val (name2, mash_isar_suggs) = get_suggs mash_isar_line

           val (name3, mash_prover_suggs) = get_suggs mash_prover_line

           val (name4, mesh_isar_suggs) = get_suggs mesh_isar_line

           val (name5, mesh_prover_suggs) = get_suggs mesh_prover_line

           val [name] =

             [name1, name2, name3, name4, name5]

             |> filter (curry (op <>) "") |> distinct (op =)

             handle General.Match => error "Input files out of sync."

           val th =

             case find_first (fn (_, th) => nickname_of_thm th = name) facts of

               SOME (_, th) => th

             | NONE => error ("No fact called \"" ^ name ^ "\".")

           val goal = goal_of_thm (Proof_Context.theory_of ctxt) th

           val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal 1

           val isar_deps = isar_dependencies_of name_tabs th

           val facts =

             facts

             |> filter (fn (_, th') =>

                           if linearize then crude_thm_ord (th', th) = LESS

                           else thm_less (th', th))

           val find_suggs =

             find_suggested_facts ctxt facts #> map fact_of_raw_fact

           fun get_facts [] compute = compute facts

             | get_facts suggs _ = find_suggs suggs

           val mepo_facts =

             get_facts mepo_suggs (fn _ =>

                 mepo_suggested_facts ctxt params prover slack_max_facts NONE

                                      hyp_ts concl_t facts)

             |> weight_mepo_facts

           fun mash_of suggs =

             get_facts suggs (fn _ =>

                 find_mash_suggestions ctxt slack_max_facts suggs facts [] []

                 |> fst |> map fact_of_raw_fact)

             |> weight_mash_facts

           val mash_isar_facts = mash_of mash_isar_suggs

           val mash_prover_facts = mash_of mash_prover_suggs

           fun mess_of mash_facts =

             [(mepo_weight, (mepo_facts, [])),

              (mash_weight, (mash_facts, []))]

           fun mesh_of suggs mash_facts =

             get_facts suggs (fn _ =>

                 mesh_facts (Thm.eq_thm_prop o pairself snd) slack_max_facts

                            (mess_of mash_facts))

           val mesh_isar_facts = mesh_of mesh_isar_suggs mash_isar_facts

           val mesh_prover_facts = mesh_of mesh_prover_suggs mash_prover_facts

           val isar_facts = find_suggs isar_deps

           (* adapted from "mirabelle_sledgehammer.ML" *)

           fun set_file_name method (SOME dir) =

               let

                 val prob_prefix =

                   "goal_" ^ string_of_int j ^ "__" ^ encode_str name ^ "__" ^

                   method

               in

                 Config.put dest_dir dir

                 #> Config.put problem_prefix (prob_prefix ^ "__")

                 #> Config.put SMT_Config.debug_files (dir ^ "/" ^ prob_prefix)

               end

             | set_file_name _ NONE = I

           fun prove method get facts =

             if not (member (op =) methods method) orelse

                (null facts andalso method <> IsarN) then

               (str_of_method method ^ "Skipped", 0)

             else

               let

                 fun nickify ((_, stature), th) =

                   ((K (encode_str (nickname_of_thm th)), stature), th)

                 val facts =

                   facts

                   |> map (get #> nickify)

                   |> maybe_instantiate_inducts ctxt hyp_ts concl_t

                   |> take (the max_facts)

                   |> map fact_of_raw_fact

                 val ctxt = ctxt |> set_file_name method prob_dir_name

                 val res as {outcome, ...} =

                   run_prover_for_mash ctxt params prover facts goal

                 val ok = if is_none outcome then 1 else 0

               in (str_of_result method facts res, ok) end

           val ress =

             [fn () => prove MePoN fst mepo_facts,

              fn () => prove MaSh_IsarN fst mash_isar_facts,

              fn () => prove MaSh_ProverN fst mash_prover_facts,

              fn () => prove MeSh_IsarN I mesh_isar_facts,

              fn () => prove MeSh_ProverN I mesh_prover_facts,

              fn () => prove IsarN I isar_facts]

             |> (* Par_List. *) map (fn f => f ())

         in

           "Goal " ^ string_of_int j ^ ": " ^ name :: map fst ress

           |> cat_lines |> print;

           map snd ress

         end

       else

         zeros

     fun total_of method ok n =

       str_of_method method ^ string_of_int ok ^ " (" ^

       Real.fmt (StringCvt.FIX (SOME 1))

                (100.0 * Real.fromInt ok / Real.fromInt (Int.max (1, n))) ^ "%)"

     val inst_inducts = Config.get ctxt instantiate_inducts

     val options =

       ["prover = " ^ prover,

        "max_facts = " ^ string_of_int (the max_facts),

        "slice" |> not slice ? prefix "dont_",

        "type_enc = " ^ the_default "smart" type_enc,

        "lam_trans = " ^ the_default "smart" lam_trans,

        "timeout = " ^ ATP_Util.string_from_time (the_default one_year timeout),

        "instantiate_inducts" |> not inst_inducts ? prefix "dont_"]

     val _ = print " * * *";

     val _ = print ("Options: " ^ commas options);

     val oks = Par_List.map solve_goal (tag_list 1 lines)

     val n = length oks

     val [mepo_ok, mash_isar_ok, mash_prover_ok, mesh_isar_ok, mesh_prover_ok,

          isar_ok] =

       if n = 0 then zeros else map Integer.sum (map_transpose I oks)

   in

     ["Successes (of " ^ string_of_int n ^ " goals)",

      total_of MePoN mepo_ok n,

      total_of MaSh_IsarN mash_isar_ok n,

      total_of MaSh_ProverN mash_prover_ok n,

      total_of MeSh_IsarN mesh_isar_ok n,

      total_of MeSh_ProverN mesh_prover_ok n,

      total_of IsarN isar_ok n]

     |> cat_lines |> print

   end

 end;