(*  Title:      HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML

     Author:     Jasmin Blanchette, TU Munich

 *)

 structure Mirabelle_Sledgehammer_Filter : MIRABELLE_ACTION =

 struct

 fun get args name default_value =

   case AList.lookup (op =) args name of

     SOME value => the (Real.fromString value)

   | NONE => default_value

 fun extract_relevance_fudge args

       {allow_ext, local_const_multiplier, worse_irrel_freq,

        higher_order_irrel_weight, abs_rel_weight, abs_irrel_weight,

        skolem_irrel_weight, theory_const_rel_weight, theory_const_irrel_weight,

        intro_bonus, elim_bonus, simp_bonus, local_bonus, assum_bonus,

        chained_bonus, max_imperfect, max_imperfect_exp, threshold_divisor,

        ridiculous_threshold} =

   {allow_ext = allow_ext,

    local_const_multiplier =

        get args "local_const_multiplier" local_const_multiplier,

    worse_irrel_freq = get args "worse_irrel_freq" worse_irrel_freq,

    higher_order_irrel_weight =

        get args "higher_order_irrel_weight" higher_order_irrel_weight,

    abs_rel_weight = get args "abs_rel_weight" abs_rel_weight,

    abs_irrel_weight = get args "abs_irrel_weight" abs_irrel_weight,

    skolem_irrel_weight = get args "skolem_irrel_weight" skolem_irrel_weight,

    theory_const_rel_weight =

        get args "theory_const_rel_weight" theory_const_rel_weight,

    theory_const_irrel_weight =

        get args "theory_const_irrel_weight" theory_const_irrel_weight,

    intro_bonus = get args "intro_bonus" intro_bonus,

    elim_bonus = get args "elim_bonus" elim_bonus,

    simp_bonus = get args "simp_bonus" simp_bonus,

    local_bonus = get args "local_bonus" local_bonus,

    assum_bonus = get args "assum_bonus" assum_bonus,

    chained_bonus = get args "chained_bonus" chained_bonus,

    max_imperfect = get args "max_imperfect" max_imperfect,

    max_imperfect_exp = get args "max_imperfect_exp" max_imperfect_exp,

    threshold_divisor = get args "threshold_divisor" threshold_divisor,

    ridiculous_threshold = get args "ridiculous_threshold" ridiculous_threshold}

 structure Prooftab =

   Table(type key = int * int val ord = prod_ord int_ord int_ord)

 val proof_table = Unsynchronized.ref (Prooftab.empty: string list list Prooftab.table)

 val num_successes = Unsynchronized.ref ([] : (int * int) list)

 val num_failures = Unsynchronized.ref ([] : (int * int) list)

 val num_found_proofs = Unsynchronized.ref ([] : (int * int) list)

 val num_lost_proofs = Unsynchronized.ref ([] : (int * int) list)

 val num_found_facts = Unsynchronized.ref ([] : (int * int) list)

 val num_lost_facts = Unsynchronized.ref ([] : (int * int) list)

 fun get id c = the_default 0 (AList.lookup (op =) (!c) id)

 fun add id c n =

   c := (case AList.lookup (op =) (!c) id of

           SOME m => AList.update (op =) (id, m + n) (!c)

         | NONE => (id, n) :: !c)

 fun init proof_file _ thy =

   let

     fun do_line line =

       case line |> space_explode ":" of

         [line_num, col_num, proof] =>

         SOME (pairself (the o Int.fromString) (line_num, col_num),

               proof |> space_explode " " |> filter_out (curry (op =) ""))

        | _ => NONE

     val proofs = File.read (Path.explode proof_file)

     val proof_tab =

       proofs |> space_explode "\n"

              |> map_filter do_line

              |> AList.coalesce (op =)

              |> Prooftab.make

   in proof_table := proof_tab; thy end

 fun percentage a b = if b = 0 then "N/A" else string_of_int (a * 100 div b)

 fun percentage_alt a b = percentage a (a + b)

 fun done id ({log, ...} : Mirabelle.done_args) =

   if get id num_successes + get id num_failures > 0 then

     (log "";

      log ("Number of overall successes: " ^

           string_of_int (get id num_successes));

      log ("Number of overall failures: " ^ string_of_int (get id num_failures));

      log ("Overall success rate: " ^

           percentage_alt (get id num_successes) (get id num_failures) ^ "%");

      log ("Number of found proofs: " ^ string_of_int (get id num_found_proofs));

      log ("Number of lost proofs: " ^ string_of_int (get id num_lost_proofs));

      log ("Proof found rate: " ^

           percentage_alt (get id num_found_proofs) (get id num_lost_proofs) ^

           "%");

      log ("Number of found facts: " ^ string_of_int (get id num_found_facts));

      log ("Number of lost facts: " ^ string_of_int (get id num_lost_facts));

      log ("Fact found rate: " ^

           percentage_alt (get id num_found_facts) (get id num_lost_facts) ^

           "%"))

   else

     ()

 val default_prover = ATP_Systems.eN (* arbitrary ATP *)

 fun with_index (i, s) = s ^ "@" ^ string_of_int i

 fun action args id ({pre, pos, log, ...} : Mirabelle.run_args) =

   case (Position.line_of pos, Position.column_of pos) of

     (SOME line_num, SOME col_num) =>

     (case Prooftab.lookup (!proof_table) (line_num, col_num) of

        SOME proofs =>

        let

          val {context = ctxt, facts, goal} = Proof.goal pre

          val prover = AList.lookup (op =) args "prover"

                       |> the_default default_prover

          val {relevance_thresholds, type_sys, max_relevant, slicing, ...} =

            Sledgehammer_Isar.default_params ctxt args

          val default_max_relevant =

            Sledgehammer_Provers.default_max_relevant_for_prover ctxt slicing

                                                                 prover

          val is_built_in_const =

            Sledgehammer_Provers.is_built_in_const_for_prover ctxt default_prover

          val relevance_fudge =

            extract_relevance_fudge args

                (Sledgehammer_Provers.relevance_fudge_for_prover ctxt prover)

          val relevance_override = {add = [], del = [], only = false}

          val subgoal = 1

          val (_, hyp_ts, concl_t) = Sledgehammer_Util.strip_subgoal goal subgoal

          val facts =

            Sledgehammer_Filter.relevant_facts ctxt relevance_thresholds

                (the_default default_max_relevant max_relevant) is_built_in_const

                relevance_fudge relevance_override facts hyp_ts concl_t

            |> map (fst o fst)

          val (found_facts, lost_facts) =

            flat proofs |> sort_distinct string_ord

            |> map (fn fact => (find_index (curry (op =) fact) facts, fact))

            |> List.partition (curry (op <=) 0 o fst)

            |>> sort (prod_ord int_ord string_ord) ||> map snd

          val found_proofs = filter (forall (member (op =) facts)) proofs

          val n = length found_proofs

          val _ =

            if n = 0 then

              (add id num_failures 1; log "Failure")

            else

              (add id num_successes 1;

               add id num_found_proofs n;

               log ("Success (" ^ string_of_int n ^ " of " ^

                    string_of_int (length proofs) ^ " proofs)"))

          val _ = add id num_lost_proofs (length proofs - n)

          val _ = add id num_found_facts (length found_facts)

          val _ = add id num_lost_facts (length lost_facts)

          val _ =

            if null found_facts then

              ()

            else

              let

                val found_weight =

                  Real.fromInt (fold (fn (n, _) =>

                                         Integer.add (n * n)) found_facts 0)

                    / Real.fromInt (length found_facts)

                  |> Math.sqrt |> Real.ceil

              in

                log ("Found facts (among " ^ string_of_int (length facts) ^

                     ", weight " ^ string_of_int found_weight ^ "): " ^

                     commas (map with_index found_facts))

              end

          val _ = if null lost_facts then

                    ()

                  else

                    log ("Lost facts (among " ^ string_of_int (length facts) ^

                         "): " ^ commas lost_facts)

        in () end

      | NONE => log "No known proof")

   | _ => ()

 val proof_fileK = "proof_file"

 fun invoke args =

   let

     val (pf_args, other_args) =

       args |> List.partition (curry (op =) proof_fileK o fst)

     val proof_file = case pf_args of

                        [] => error "No \"proof_file\" specified"

                      | (_, s) :: _ => s

   in Mirabelle.register (init proof_file, action other_args, done) end

 end;

 (* Workaround to keep the "mirabelle.pl" script happy *)

 structure Mirabelle_Sledgehammer_filter = Mirabelle_Sledgehammer_Filter;