src/Tools/try.ML
author blanchet
Fri, 27 May 2011 10:30:08 +0200
changeset 43859 121aa59b4d17
parent 41175 src/Tools/auto_tools.ML@061b8257ab9f
child 43861 abb5d1f907e4
permissions -rw-r--r--
renamed "Auto_Tools" "Try"
blanchet@43859
     1
(*  Title:      Tools/try.ML
blanchet@33552
     2
    Author:     Jasmin Blanchette, TU Muenchen
blanchet@33552
     3
blanchet@43859
     4
Manager for tools that should be tried on conjectures.
blanchet@33552
     5
*)
blanchet@33552
     6
blanchet@43859
     7
signature TRY =
blanchet@33552
     8
sig
blanchet@43859
     9
  val auto_time_limit: real Unsynchronized.ref
blanchet@33552
    10
blanchet@33552
    11
  val register_tool :
blanchet@41175
    12
    bool Unsynchronized.ref * (Proof.state -> bool * Proof.state) -> theory
blanchet@41175
    13
    -> theory
blanchet@33552
    14
end;
blanchet@33552
    15
blanchet@43859
    16
structure Try : TRY =
blanchet@33552
    17
struct
blanchet@33552
    18
blanchet@33552
    19
(* preferences *)
blanchet@33552
    20
blanchet@43859
    21
val auto_time_limit = Unsynchronized.ref 4.0
blanchet@33552
    22
blanchet@43859
    23
val auto_try_time_limitN = "auto-try-time-limit"
blanchet@33552
    24
val _ =
blanchet@33552
    25
  ProofGeneralPgip.add_preference Preferences.category_tracing
blanchet@43859
    26
    (Preferences.real_pref auto_time_limit
blanchet@43859
    27
      auto_try_time_limitN "Time limit for automatically tried tools (in seconds).")
blanchet@33552
    28
blanchet@33552
    29
blanchet@33552
    30
(* configuration *)
blanchet@33552
    31
wenzelm@33600
    32
structure Data = Theory_Data
wenzelm@33600
    33
(
blanchet@41175
    34
  type T = (bool Unsynchronized.ref * (Proof.state -> bool * Proof.state)) list
blanchet@33552
    35
  val empty = []
blanchet@33552
    36
  val extend = I
wenzelm@33600
    37
  fun merge data : T = AList.merge (op =) (K true) data
blanchet@33552
    38
)
blanchet@33552
    39
blanchet@33552
    40
val register_tool = Data.map o AList.update (op =)
blanchet@33552
    41
blanchet@33552
    42
blanchet@33552
    43
(* automatic testing *)
blanchet@33552
    44
blanchet@41175
    45
fun run_tools tools state =
blanchet@41175
    46
  tools |> map_filter (fn (auto, tool) => if !auto then SOME tool else NONE)
blanchet@41175
    47
        |> Par_List.get_some (fn tool =>
blanchet@41175
    48
                                 case try tool state of
blanchet@41175
    49
                                   SOME (true, state) => SOME state
blanchet@41175
    50
                                 | _ => NONE)
blanchet@41175
    51
        |> the_default state
blanchet@41175
    52
blanchet@41175
    53
(* Too large values are understood as milliseconds, ensuring compatibility with
blanchet@41175
    54
   old setting files. No users can possibly in their right mind want the user
blanchet@41175
    55
   interface to block for more than 100 seconds. *)
blanchet@41175
    56
fun smart_seconds r =
blanchet@41175
    57
  seconds (if r >= 100.0 then
blanchet@43859
    58
             (legacy_feature (quote auto_try_time_limitN ^
blanchet@41175
    59
                " expressed in milliseconds -- use seconds instead"); 0.001 * r)
blanchet@41175
    60
           else
blanchet@41175
    61
             r)
blanchet@41175
    62
blanchet@33552
    63
val _ = Context.>> (Specification.add_theorem_hook (fn interact => fn state =>
blanchet@43859
    64
  if interact andalso not (!Toplevel.quiet) andalso !auto_time_limit > 0.0 then
blanchet@43859
    65
    TimeLimit.timeLimit (smart_seconds (!auto_time_limit))
blanchet@41175
    66
        (run_tools (Data.get (Proof.theory_of state))) state
blanchet@41175
    67
    handle TimeLimit.TimeOut => state
blanchet@41175
    68
  else
blanchet@41175
    69
    state))
blanchet@33552
    70
blanchet@33552
    71
end;