src/HOL/Tools/ATP/atp_problem.ML
changeset 42962 3b50fdeb6cfc
parent 42961 f30ae82cb62e
child 42963 5725deb11ae7
equal deleted inserted replaced
42961:f30ae82cb62e 42962:3b50fdeb6cfc
    13   datatype ('a, 'b, 'c) formula =
    13   datatype ('a, 'b, 'c) formula =
    14     AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c) formula |
    14     AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c) formula |
    15     AConn of connective * ('a, 'b, 'c) formula list |
    15     AConn of connective * ('a, 'b, 'c) formula list |
    16     AAtom of 'c
    16     AAtom of 'c
    17 
    17 
    18   datatype format = CNF_UEQ | FOF | TFF
    18   datatype format = CNF_UEQ | FOF | TFF | THF
    19   datatype formula_kind = Axiom | Definition | Lemma | Hypothesis | Conjecture
    19   datatype formula_kind = Axiom | Definition | Lemma | Hypothesis | Conjecture
    20   datatype 'a problem_line =
    20   datatype 'a problem_line =
    21     Decl of string * 'a * 'a list * 'a |
    21     Decl of string * 'a * 'a list * 'a |
    22     Formula of string * formula_kind * ('a, 'a, 'a fo_term) formula
    22     Formula of string * formula_kind * ('a, 'a, 'a fo_term) formula
    23                * string fo_term option * string fo_term option
    23                * string fo_term option * string fo_term option
    25 
    25 
    26   (* official TPTP syntax *)
    26   (* official TPTP syntax *)
    27   val tptp_special_prefix : string
    27   val tptp_special_prefix : string
    28   val tptp_false : string
    28   val tptp_false : string
    29   val tptp_true : string
    29   val tptp_true : string
    30   val tptp_tff_type_of_types : string
    30   val tptp_type_of_types : string
    31   val tptp_tff_bool_type : string
    31   val tptp_bool_type : string
    32   val tptp_tff_individual_type : string
    32   val tptp_individual_type : string
    33   val is_atp_variable : string -> bool
    33   val is_atp_variable : string -> bool
    34   val mk_anot : ('a, 'b, 'c) formula -> ('a, 'b, 'c) formula
    34   val mk_anot : ('a, 'b, 'c) formula -> ('a, 'b, 'c) formula
    35   val mk_aconn :
    35   val mk_aconn :
    36     connective -> ('a, 'b, 'c) formula -> ('a, 'b, 'c) formula
    36     connective -> ('a, 'b, 'c) formula -> ('a, 'b, 'c) formula
    37     -> ('a, 'b, 'c) formula
    37     -> ('a, 'b, 'c) formula
    59 datatype ('a, 'b, 'c) formula =
    59 datatype ('a, 'b, 'c) formula =
    60   AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c) formula |
    60   AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c) formula |
    61   AConn of connective * ('a, 'b, 'c) formula list |
    61   AConn of connective * ('a, 'b, 'c) formula list |
    62   AAtom of 'c
    62   AAtom of 'c
    63 
    63 
    64 datatype format = CNF_UEQ | FOF | TFF
    64 datatype format = CNF_UEQ | FOF | TFF | THF
    65 datatype formula_kind = Axiom | Definition | Lemma | Hypothesis | Conjecture
    65 datatype formula_kind = Axiom | Definition | Lemma | Hypothesis | Conjecture
    66 datatype 'a problem_line =
    66 datatype 'a problem_line =
    67   Decl of string * 'a * 'a list * 'a |
    67   Decl of string * 'a * 'a list * 'a |
    68   Formula of string * formula_kind * ('a, 'a, 'a fo_term) formula
    68   Formula of string * formula_kind * ('a, 'a, 'a fo_term) formula
    69              * string fo_term option * string fo_term option
    69              * string fo_term option * string fo_term option
    71 
    71 
    72 (* official TPTP syntax *)
    72 (* official TPTP syntax *)
    73 val tptp_special_prefix = "$"
    73 val tptp_special_prefix = "$"
    74 val tptp_false = "$false"
    74 val tptp_false = "$false"
    75 val tptp_true = "$true"
    75 val tptp_true = "$true"
    76 val tptp_tff_type_of_types = "$tType"
    76 val tptp_type_of_types = "$tType"
    77 val tptp_tff_bool_type = "$o"
    77 val tptp_bool_type = "$o"
    78 val tptp_tff_individual_type = "$i"
    78 val tptp_individual_type = "$i"
    79 
    79 
    80 fun is_atp_variable s = Char.isUpper (String.sub (s, 0))
    80 fun is_atp_variable s = Char.isUpper (String.sub (s, 0))
    81 
    81 
    82 fun mk_anot (AConn (ANot, [phi])) = phi
    82 fun mk_anot (AConn (ANot, [phi])) = phi
    83   | mk_anot phi = AConn (ANot, [phi])
    83   | mk_anot phi = AConn (ANot, [phi])
    87   | formula_map f (AConn (c, phis)) = AConn (c, map (formula_map f) phis)
    87   | formula_map f (AConn (c, phis)) = AConn (c, map (formula_map f) phis)
    88   | formula_map f (AAtom tm) = AAtom (f tm)
    88   | formula_map f (AAtom tm) = AAtom (f tm)
    89 
    89 
    90 val timestamp = Date.fmt "%Y-%m-%d %H:%M:%S" o Date.fromTimeLocal o Time.now
    90 val timestamp = Date.fmt "%Y-%m-%d %H:%M:%S" o Date.fromTimeLocal o Time.now
    91 
    91 
    92 (* This hash function is recommended in Compilers: Principles, Techniques, and
    92 (* This hash function is recommended in "Compilers: Principles, Techniques, and
    93    Tools, by Aho, Sethi, and Ullman. The "hashpjw" function, which they
    93    Tools" by Aho, Sethi, and Ullman. The "hashpjw" function, which they
    94    particularly recommend, triggers a bug in versions of Poly/ML up to 4.2.0. *)
    94    particularly recommend, triggers a bug in versions of Poly/ML up to 4.2.0. *)
    95 fun hashw (u, w) = Word.+ (u, Word.* (0w65599, w))
    95 fun hashw (u, w) = Word.+ (u, Word.* (0w65599, w))
    96 fun hashw_char (c, w) = hashw (Word.fromInt (Char.ord c), w)
    96 fun hashw_char (c, w) = hashw (Word.fromInt (Char.ord c), w)
    97 fun hashw_string (s : string, w) = CharVector.foldl hashw_char w s
    97 fun hashw_string (s : string, w) = CharVector.foldl hashw_char w s
    98 
    98 
   100   | string_for_kind Definition = "definition"
   100   | string_for_kind Definition = "definition"
   101   | string_for_kind Lemma = "lemma"
   101   | string_for_kind Lemma = "lemma"
   102   | string_for_kind Hypothesis = "hypothesis"
   102   | string_for_kind Hypothesis = "hypothesis"
   103   | string_for_kind Conjecture = "conjecture"
   103   | string_for_kind Conjecture = "conjecture"
   104 
   104 
   105 fun string_for_term (ATerm (s, [])) = s
   105 fun string_for_term _ (ATerm (s, [])) = s
   106   | string_for_term (ATerm ("equal", ts)) =
   106   | string_for_term format (ATerm ("equal", ts)) =
   107     space_implode " = " (map string_for_term ts)
   107     space_implode " = " (map (string_for_term format) ts)
   108   | string_for_term (ATerm ("[]", ts)) =
   108     |> format = THF ? enclose "(" ")"
       
   109   | string_for_term format (ATerm ("[]", ts)) =
   109     (* used for lists in the optional "source" field of a derivation *)
   110     (* used for lists in the optional "source" field of a derivation *)
   110     "[" ^ commas (map string_for_term ts) ^ "]"
   111     "[" ^ commas (map (string_for_term format) ts) ^ "]"
   111   | string_for_term (ATerm (s, ts)) =
   112   | string_for_term format (ATerm (s, ts)) =
   112     s ^ "(" ^ commas (map string_for_term ts) ^ ")"
   113     let val ss = map (string_for_term format) ts in
       
   114       if format = THF then "(" ^ space_implode " @ " (s :: ss) ^ ")"
       
   115       else s ^ "(" ^ commas ss ^ ")"
       
   116     end
   113 fun string_for_quantifier AForall = "!"
   117 fun string_for_quantifier AForall = "!"
   114   | string_for_quantifier AExists = "?"
   118   | string_for_quantifier AExists = "?"
   115 fun string_for_connective ANot = "~"
   119 fun string_for_connective ANot = "~"
   116   | string_for_connective AAnd = "&"
   120   | string_for_connective AAnd = "&"
   117   | string_for_connective AOr = "|"
   121   | string_for_connective AOr = "|"
   118   | string_for_connective AImplies = "=>"
   122   | string_for_connective AImplies = "=>"
   119   | string_for_connective AIf = "<="
   123   | string_for_connective AIf = "<="
   120   | string_for_connective AIff = "<=>"
   124   | string_for_connective AIff = "<=>"
   121   | string_for_connective ANotIff = "<~>"
   125   | string_for_connective ANotIff = "<~>"
   122 fun string_for_bound_var TFF (s, ty) =
   126 fun string_for_bound_var format (s, ty) =
   123     s ^ " : " ^ (ty |> the_default tptp_tff_individual_type)
   127     s ^ (if format = TFF orelse format = THF then
   124   | string_for_bound_var _ (s, _) = s
   128            " : " ^ (ty |> the_default tptp_individual_type)
       
   129          else
       
   130            "")
   125 fun string_for_formula format (AQuant (q, xs, phi)) =
   131 fun string_for_formula format (AQuant (q, xs, phi)) =
   126     "(" ^ string_for_quantifier q ^
   132     "(" ^ string_for_quantifier q ^
   127     "[" ^ commas (map (string_for_bound_var format) xs) ^ "] : " ^
   133     "[" ^ commas (map (string_for_bound_var format) xs) ^ "] : " ^
   128     string_for_formula format phi ^ ")"
   134     string_for_formula format phi ^ ")"
   129   | string_for_formula _ (AConn (ANot, [AAtom (ATerm ("equal", ts))])) =
   135   | string_for_formula format (AConn (ANot, [AAtom (ATerm ("equal", ts))])) =
   130     space_implode " != " (map string_for_term ts)
   136     space_implode " != " (map (string_for_term format) ts)
   131   | string_for_formula format (AConn (c, [phi])) =
   137   | string_for_formula format (AConn (c, [phi])) =
   132     "(" ^ string_for_connective c ^ " " ^ string_for_formula format phi ^ ")"
   138     "(" ^ string_for_connective c ^ " " ^ string_for_formula format phi ^ ")"
   133   | string_for_formula format (AConn (c, phis)) =
   139   | string_for_formula format (AConn (c, phis)) =
   134     "(" ^ space_implode (" " ^ string_for_connective c ^ " ")
   140     "(" ^ space_implode (" " ^ string_for_connective c ^ " ")
   135                         (map (string_for_formula format) phis) ^ ")"
   141                         (map (string_for_formula format) phis) ^ ")"
   136   | string_for_formula _ (AAtom tm) = string_for_term tm
   142   | string_for_formula format (AAtom tm) = string_for_term format tm
   137 
   143 
   138 fun string_for_symbol_type [] res_ty = res_ty
   144 fun string_for_symbol_type THF arg_tys res_ty =
   139   | string_for_symbol_type [arg_ty] res_ty = arg_ty ^ " > " ^ res_ty
   145     space_implode " > " (arg_tys @ [res_ty])
   140   | string_for_symbol_type arg_tys res_ty =
   146   | string_for_symbol_type _ [] res_ty = res_ty
   141     string_for_symbol_type ["(" ^ space_implode " * " arg_tys ^ ")"] res_ty
   147   | string_for_symbol_type _ [arg_ty] res_ty = arg_ty ^ " > " ^ res_ty
       
   148   | string_for_symbol_type format arg_tys res_ty =
       
   149     string_for_symbol_type format ["(" ^ space_implode " * " arg_tys ^ ")"]
       
   150                            res_ty
   142 
   151 
   143 val default_source =
   152 val default_source =
   144   ATerm ("inference", ATerm ("isabelle", []) :: replicate 2 (ATerm ("[]", [])))
   153   ATerm ("inference", ATerm ("isabelle", []) :: replicate 2 (ATerm ("[]", [])))
   145 
   154 
   146 fun string_for_problem_line _ (Decl (ident, sym, arg_tys, res_ty)) =
   155 fun string_for_format CNF_UEQ = "cnf"
   147     "tff(" ^ ident ^ ", type,\n    " ^ sym ^ " : " ^
   156   | string_for_format FOF = "fof"
   148     string_for_symbol_type arg_tys res_ty ^ ").\n"
   157   | string_for_format TFF = "tff"
       
   158   | string_for_format THF = "thf"
       
   159 
       
   160 fun string_for_problem_line format (Decl (ident, sym, arg_tys, res_ty)) =
       
   161     string_for_format format ^ "(" ^ ident ^ ", type,\n    " ^ sym ^ " : " ^
       
   162     string_for_symbol_type format arg_tys res_ty ^ ").\n"
   149   | string_for_problem_line format (Formula (ident, kind, phi, source, info)) =
   163   | string_for_problem_line format (Formula (ident, kind, phi, source, info)) =
   150     (case format of CNF_UEQ => "cnf" | FOF => "fof" | TFF => "tff") ^
   164     string_for_format format ^ "(" ^ ident ^ ", " ^ string_for_kind kind ^
   151     "(" ^ ident ^ ", " ^ string_for_kind kind ^ ",\n    (" ^
   165     ",\n    (" ^ string_for_formula format phi ^ ")" ^
   152     string_for_formula format phi ^ ")" ^
       
   153     (case (source, info) of
   166     (case (source, info) of
   154        (NONE, NONE) => ""
   167        (NONE, NONE) => ""
   155      | (SOME tm, NONE) => ", " ^ string_for_term tm
   168      | (SOME tm, NONE) => ", " ^ string_for_term format tm
   156      | (_, SOME tm) =>
   169      | (_, SOME tm) =>
   157        ", " ^ string_for_term (source |> the_default default_source) ^
   170        ", " ^ string_for_term format (source |> the_default default_source) ^
   158        ", " ^ string_for_term tm) ^ ").\n"
   171        ", " ^ string_for_term format tm) ^ ").\n"
   159 fun tptp_strings_for_atp_problem format problem =
   172 fun tptp_strings_for_atp_problem format problem =
   160   "% This file was generated by Isabelle (most likely Sledgehammer)\n\
   173   "% This file was generated by Isabelle (most likely Sledgehammer)\n\
   161   \% " ^ timestamp () ^ "\n" ::
   174   \% " ^ timestamp () ^ "\n" ::
   162   maps (fn (_, []) => []
   175   maps (fn (_, []) => []
   163          | (heading, lines) =>
   176          | (heading, lines) =>
   189 
   202 
   190 fun negate_conjecture_line (Formula (ident, Conjecture, phi, source, info)) =
   203 fun negate_conjecture_line (Formula (ident, Conjecture, phi, source, info)) =
   191     Formula (ident, Hypothesis, mk_anot phi, source, info)
   204     Formula (ident, Hypothesis, mk_anot phi, source, info)
   192   | negate_conjecture_line line = line
   205   | negate_conjecture_line line = line
   193 
   206 
   194 val filter_cnf_ueq_problem =
   207 fun filter_cnf_ueq_problem problem =
   195   map (apsnd (map open_formula_line
   208   problem
   196               #> filter is_problem_line_cnf_ueq
   209   |> map (apsnd (map open_formula_line
   197               #> map negate_conjecture_line))
   210                  #> filter is_problem_line_cnf_ueq
   198   #> (fn problem =>
   211                  #> map negate_conjecture_line))
       
   212   |> (fn problem =>
   199          let
   213          let
   200            val conjs = problem |> maps snd |> filter is_problem_line_negated
   214            val conjs = problem |> maps snd |> filter is_problem_line_negated
   201          in if length conjs = 1 then problem else [] end)
   215          in if length conjs = 1 then problem else [] end)
   202 
   216 
   203 
   217 
   244                s)
   258                s)
   245       |> (fn s => if member (op =) reserved_nice_names s then full_name else s)
   259       |> (fn s => if member (op =) reserved_nice_names s then full_name else s)
   246 
   260 
   247 fun nice_name (full_name, _) NONE = (full_name, NONE)
   261 fun nice_name (full_name, _) NONE = (full_name, NONE)
   248   | nice_name (full_name, desired_name) (SOME the_pool) =
   262   | nice_name (full_name, desired_name) (SOME the_pool) =
   249     if String.isPrefix "$" full_name then
   263     if String.isPrefix tptp_special_prefix full_name then
   250       (full_name, SOME the_pool)
   264       (full_name, SOME the_pool)
   251     else case Symtab.lookup (fst the_pool) full_name of
   265     else case Symtab.lookup (fst the_pool) full_name of
   252       SOME nice_name => (nice_name, SOME the_pool)
   266       SOME nice_name => (nice_name, SOME the_pool)
   253     | NONE =>
   267     | NONE =>
   254       let
   268       let