src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML
changeset 57770 6c4ab6f0a6fc
parent 57769 5ef0531d9db2
child 57771 0265ccdb9e6f
equal deleted inserted replaced
57769:5ef0531d9db2 57770:6c4ab6f0a6fc
    92     else
    92     else
    93       map (replace_dependencies_in_line (name, [])) lines
    93       map (replace_dependencies_in_line (name, [])) lines
    94   | add_line_pass1 line lines = line :: lines
    94   | add_line_pass1 line lines = line :: lines
    95 
    95 
    96 fun add_lines_pass2 res _ [] = rev res
    96 fun add_lines_pass2 res _ [] = rev res
    97   | add_lines_pass2 res prev_t ((line as (name, role, t, rule, deps)) :: lines) =
    97   | add_lines_pass2 res (prev as (prev_name, prev_norm_t))
       
    98       ((line as (name, role, t, rule, deps)) :: lines) =
    98     let
    99     let
       
   100       val norm_t = t |> role = Conjecture ? (HOLogic.dest_Trueprop #> s_not #> HOLogic.mk_Trueprop)
       
   101 
    99       fun looks_boring () =
   102       fun looks_boring () =
   100         t aconv @{prop True} orelse t aconv @{prop False} orelse t aconv prev_t orelse
   103         t aconv @{prop True} orelse t aconv @{prop False} orelse norm_t aconv prev_norm_t orelse
   101         length deps < 2
   104         length deps < 2
   102 
   105 
   103       fun is_skolemizing_line (_, _, _, rule', deps') =
   106       fun is_skolemizing_line (_, _, _, rule', deps') =
   104         is_skolemize_rule rule' andalso member (op =) deps' name
   107         is_skolemize_rule rule' andalso member (op =) deps' name
       
   108 
   105       fun is_before_skolemize_rule () = exists is_skolemizing_line lines
   109       fun is_before_skolemize_rule () = exists is_skolemizing_line lines
   106     in
   110     in
   107       if role <> Plain orelse is_skolemize_rule rule orelse is_arith_rule rule orelse
   111       if (Term.aconv_untyped (prev_norm_t, norm_t) andalso member (op =) deps prev_name) orelse
   108          is_datatype_rule rule orelse null lines orelse not (looks_boring ()) orelse
   112           (role = Plain andalso not (is_skolemize_rule rule) andalso
   109          is_before_skolemize_rule () then
   113            not (is_arith_rule rule) andalso not (is_datatype_rule rule) andalso
   110         add_lines_pass2 (line :: res) t lines
   114            not (null lines) andalso looks_boring () andalso not (is_before_skolemize_rule ())) then
       
   115         add_lines_pass2 res prev (map (replace_dependencies_in_line (name, deps)) lines)
   111       else
   116       else
   112         add_lines_pass2 res prev_t (map (replace_dependencies_in_line (name, deps)) lines)
   117         add_lines_pass2 (line :: res) (name, norm_t) lines
   113     end
   118     end
   114 
   119 
   115 type isar_params =
   120 type isar_params =
   116   bool * (string option * string option) * Time.time * real * bool * bool
   121   bool * (string option * string option) * Time.time * real * bool * bool
   117   * (term, string) atp_step list * thm
   122   * (term, string) atp_step list * thm
   158         fun get_role keep_role ((num, _), role, t, rule, _) =
   163         fun get_role keep_role ((num, _), role, t, rule, _) =
   159           if keep_role role then SOME ((raw_label_of_num num, t), rule) else NONE
   164           if keep_role role then SOME ((raw_label_of_num num, t), rule) else NONE
   160 
   165 
   161         val atp_proof =
   166         val atp_proof =
   162           fold_rev add_line_pass1 atp_proof []
   167           fold_rev add_line_pass1 atp_proof []
   163           |> add_lines_pass2 [] Term.dummy
   168           |> add_lines_pass2 [] (("", []), Term.dummy)
   164 
   169 
   165         val conjs =
   170         val conjs =
   166           map_filter (fn (name, role, _, _, _) =>
   171           map_filter (fn (name, role, _, _, _) =>
   167               if member (op =) [Conjecture, Negated_Conjecture] role then SOME name else NONE)
   172               if member (op =) [Conjecture, Negated_Conjecture] role then SOME name else NONE)
   168             atp_proof
   173             atp_proof