src/HOL/Tools/Sledgehammer/sledgehammer_isar_proof.ML
changeset 57763 e913a87bd5d2
parent 57669 cf20bdc83854
child 57765 f1108245ba11
equal deleted inserted replaced
57762:1649841f3b38 57763:e913a87bd5d2
    44   val comment_isar_proof : (label -> proof_method list -> string) -> isar_proof -> isar_proof
    44   val comment_isar_proof : (label -> proof_method list -> string) -> isar_proof -> isar_proof
    45   val chain_isar_proof : isar_proof -> isar_proof
    45   val chain_isar_proof : isar_proof -> isar_proof
    46   val kill_useless_labels_in_isar_proof : isar_proof -> isar_proof
    46   val kill_useless_labels_in_isar_proof : isar_proof -> isar_proof
    47   val relabel_isar_proof_canonically : isar_proof -> isar_proof
    47   val relabel_isar_proof_canonically : isar_proof -> isar_proof
    48   val relabel_isar_proof_nicely : isar_proof -> isar_proof
    48   val relabel_isar_proof_nicely : isar_proof -> isar_proof
       
    49   val rename_bound_vars_in_isar_proof : isar_proof -> isar_proof
    49 
    50 
    50   val string_of_isar_proof : Proof.context -> int -> int -> isar_proof -> string
    51   val string_of_isar_proof : Proof.context -> int -> int -> isar_proof -> string
    51 end;
    52 end;
    52 
    53 
    53 structure Sledgehammer_Isar_Proof : SLEDGEHAMMER_ISAR_PROOF =
    54 structure Sledgehammer_Isar_Proof : SLEDGEHAMMER_ISAR_PROOF =
   202       |> fold_map (fn (l, t) => next_label depth assume_prefix l #> apfst (rpair t)) assms
   203       |> fold_map (fn (l, t) => next_label depth assume_prefix l #> apfst (rpair t)) assms
   203       ||>> fold_map (relabel_step depth) steps
   204       ||>> fold_map (relabel_step depth) steps
   204       |> (fn ((assms, steps), _) => Proof (fix, assms, steps))
   205       |> (fn ((assms, steps), _) => Proof (fix, assms, steps))
   205   in
   206   in
   206     relabel_proof [] 0
   207     relabel_proof [] 0
       
   208   end
       
   209 
       
   210 val Type (listT_name, _) = HOLogic.listT dummyT
       
   211 
       
   212 fun var_name_of_typ (Type (@{type_name fun}, [_, T])) =
       
   213     if body_type T = HOLogic.boolT then "p" else "f"
       
   214   | var_name_of_typ (Type (@{type_name set}, [T])) =
       
   215     Name.desymbolize (SOME true) (var_name_of_typ T)
       
   216   | var_name_of_typ (Type (s, _)) =
       
   217     if s = listT_name then "xs"
       
   218     else String.extract (Name.desymbolize (SOME false) (Long_Name.base_name s), 0, SOME 1)
       
   219   | var_name_of_typ (TFree (s, _)) =
       
   220     String.extract (Name.desymbolize (SOME false) (perhaps (try (unprefix "'")) s), 0, SOME 1)
       
   221   | var_name_of_typ (TVar ((s, _), T)) = var_name_of_typ (TFree (s, T))
       
   222 
       
   223 fun rename_bound_vars (t $ u) = rename_bound_vars t $ rename_bound_vars u
       
   224   | rename_bound_vars (Abs (_, T, t)) = Abs (var_name_of_typ T, T, rename_bound_vars t)
       
   225   | rename_bound_vars t = t
       
   226 
       
   227 val rename_bound_vars_in_isar_proof =
       
   228   let
       
   229     fun rename_step (Prove (qs, xs, l, t, subs, facts, meths, comment)) =
       
   230         Prove (qs, xs, l, rename_bound_vars t, map rename_proof subs, facts, meths, comment)
       
   231       | rename_step step = step
       
   232     and rename_proof (Proof (fix, assms, steps)) =
       
   233       Proof (fix, map (apsnd rename_bound_vars) assms, map rename_step steps)
       
   234   in
       
   235     rename_proof
   207   end
   236   end
   208 
   237 
   209 val indent_size = 2
   238 val indent_size = 2
   210 
   239 
   211 fun string_of_isar_proof ctxt0 i n proof =
   240 fun string_of_isar_proof ctxt0 i n proof =