src/HOL/Tools/ATP/atp_problem.ML
author blanchet
Wed, 17 Aug 2011 10:03:58 +0200
changeset 45106 85e9dad3c187
parent 44858 2850b7dc27a4
child 45261 f0bc74b9161e
permissions -rw-r--r--
distinguish THF syntax with and without choice (Satallax vs. LEO-II)
blanchet@38293
     1
(*  Title:      HOL/Tools/ATP/atp_problem.ML
blanchet@38261
     2
    Author:     Jia Meng, Cambridge University Computer Laboratory and NICTA
blanchet@37509
     3
    Author:     Jasmin Blanchette, TU Muenchen
blanchet@37509
     4
blanchet@39692
     5
Abstract representation of ATP problems and TPTP syntax.
blanchet@37509
     6
*)
blanchet@37509
     7
blanchet@38253
     8
signature ATP_PROBLEM =
blanchet@37509
     9
sig
nik@44535
    10
  datatype ('a, 'b) ho_term =
nik@44535
    11
    ATerm of 'a * ('a, 'b) ho_term list |
nik@44535
    12
    AAbs of ('a * 'b) * ('a, 'b) ho_term
blanchet@38226
    13
  datatype quantifier = AForall | AExists
blanchet@44004
    14
  datatype connective = ANot | AAnd | AOr | AImplies | AIff
blanchet@43402
    15
  datatype ('a, 'b, 'c) formula =
blanchet@43402
    16
    AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c) formula |
blanchet@43402
    17
    AConn of connective * ('a, 'b, 'c) formula list |
blanchet@43402
    18
    AAtom of 'c
blanchet@38228
    19
blanchet@43804
    20
  datatype 'a ho_type = AType of 'a | AFun of 'a ho_type * 'a ho_type
blanchet@43804
    21
blanchet@45106
    22
  datatype thf_flavor = Without_Choice | With_Choice
blanchet@45106
    23
  datatype format =
blanchet@45106
    24
    CNF |
blanchet@45106
    25
    CNF_UEQ |
blanchet@45106
    26
    FOF |
blanchet@45106
    27
    TFF |
blanchet@45106
    28
    THF of thf_flavor
blanchet@45106
    29
blanchet@43396
    30
  datatype formula_kind = Axiom | Definition | Lemma | Hypothesis | Conjecture
blanchet@43398
    31
  datatype 'a problem_line =
blanchet@43804
    32
    Decl of string * 'a * 'a ho_type |
nik@44535
    33
    Formula of string * formula_kind * ('a, 'a ho_type, ('a, 'a ho_type) ho_term) formula
nik@44535
    34
               * (string, string ho_type) ho_term option * (string, string ho_type) ho_term option
blanchet@38251
    35
  type 'a problem = (string * 'a problem_line list) list
blanchet@38226
    36
blanchet@43809
    37
  val tptp_cnf : string
blanchet@43809
    38
  val tptp_fof : string
blanchet@43809
    39
  val tptp_tff : string
blanchet@43809
    40
  val tptp_thf : string
blanchet@43808
    41
  val tptp_has_type : string
blanchet@43803
    42
  val tptp_type_of_types : string
blanchet@43803
    43
  val tptp_bool_type : string
blanchet@43803
    44
  val tptp_individual_type : string
blanchet@43804
    45
  val tptp_fun_type : string
blanchet@43839
    46
  val tptp_product_type : string
blanchet@43809
    47
  val tptp_forall : string
nik@44537
    48
  val tptp_ho_forall : string
blanchet@43809
    49
  val tptp_exists : string
nik@44537
    50
  val tptp_ho_exists : string
blanchet@43809
    51
  val tptp_not : string
blanchet@43809
    52
  val tptp_and : string
blanchet@43809
    53
  val tptp_or : string
blanchet@43809
    54
  val tptp_implies : string
blanchet@43809
    55
  val tptp_if : string
blanchet@43809
    56
  val tptp_iff : string
blanchet@43809
    57
  val tptp_not_iff : string
blanchet@43809
    58
  val tptp_app : string
blanchet@43809
    59
  val tptp_not_infix : string
blanchet@43809
    60
  val tptp_equal : string
blanchet@43841
    61
  val tptp_old_equal : string
blanchet@43807
    62
  val tptp_false : string
blanchet@43807
    63
  val tptp_true : string
blanchet@43841
    64
  val tptp_empty_list : string
blanchet@43841
    65
  val is_tptp_equal : string -> bool
blanchet@43839
    66
  val is_built_in_tptp_symbol : string -> bool
blanchet@43839
    67
  val is_tptp_variable : string -> bool
blanchet@43839
    68
  val is_tptp_user_symbol : string -> bool
blanchet@43783
    69
  val mk_anot : ('a, 'b, 'c) formula -> ('a, 'b, 'c) formula
blanchet@43783
    70
  val mk_aconn :
blanchet@43783
    71
    connective -> ('a, 'b, 'c) formula -> ('a, 'b, 'c) formula
blanchet@43783
    72
    -> ('a, 'b, 'c) formula
blanchet@43839
    73
  val aconn_fold :
blanchet@43839
    74
    bool option -> (bool option -> 'a -> 'b -> 'b) -> connective * 'a list
blanchet@43839
    75
    -> 'b -> 'b
blanchet@43839
    76
  val aconn_map :
blanchet@43839
    77
    bool option -> (bool option -> 'a -> ('b, 'c, 'd) formula)
blanchet@43839
    78
    -> connective * 'a list -> ('b, 'c, 'd) formula
blanchet@43839
    79
  val formula_fold :
blanchet@43839
    80
    bool option -> (bool option -> 'c -> 'd -> 'd) -> ('a, 'b, 'c) formula
blanchet@43839
    81
    -> 'd -> 'd
blanchet@43785
    82
  val formula_map : ('c -> 'd) -> ('a, 'b, 'c) formula -> ('a, 'b, 'd) formula
blanchet@45106
    83
  val is_format_thf : format -> bool
blanchet@43839
    84
  val is_format_typed : format -> bool
blanchet@44065
    85
  val tptp_lines_for_atp_problem : format -> string problem -> string list
blanchet@43933
    86
  val ensure_cnf_problem :
blanchet@43933
    87
    (string * string) problem -> (string * string) problem
blanchet@43780
    88
  val filter_cnf_ueq_problem :
blanchet@43780
    89
    (string * string) problem -> (string * string) problem
blanchet@43839
    90
  val declare_undeclared_syms_in_atp_problem :
blanchet@43839
    91
    string -> string -> (string * string) problem -> (string * string) problem
blanchet@39692
    92
  val nice_atp_problem :
blanchet@38251
    93
    bool -> ('a * (string * string) problem_line list) list
blanchet@38251
    94
    -> ('a * string problem_line list) list
blanchet@38251
    95
       * (string Symtab.table * string Symtab.table) option
blanchet@37509
    96
end;
blanchet@37509
    97
blanchet@38253
    98
structure ATP_Problem : ATP_PROBLEM =
blanchet@37509
    99
struct
blanchet@37509
   100
blanchet@43926
   101
open ATP_Util
blanchet@43926
   102
blanchet@43926
   103
blanchet@37643
   104
(** ATP problem **)
blanchet@37643
   105
nik@44535
   106
datatype ('a, 'b) ho_term =
nik@44535
   107
  ATerm of 'a * ('a, 'b) ho_term list |
nik@44535
   108
  AAbs of ('a * 'b) * ('a, 'b) ho_term
blanchet@38198
   109
datatype quantifier = AForall | AExists
blanchet@44004
   110
datatype connective = ANot | AAnd | AOr | AImplies | AIff
blanchet@43402
   111
datatype ('a, 'b, 'c) formula =
blanchet@43402
   112
  AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c) formula |
blanchet@43402
   113
  AConn of connective * ('a, 'b, 'c) formula list |
blanchet@43402
   114
  AAtom of 'c
blanchet@38198
   115
blanchet@43804
   116
datatype 'a ho_type = AType of 'a | AFun of 'a ho_type * 'a ho_type
blanchet@43804
   117
blanchet@45106
   118
datatype thf_flavor = Without_Choice | With_Choice
blanchet@45106
   119
datatype format =
blanchet@45106
   120
  CNF |
blanchet@45106
   121
  CNF_UEQ |
blanchet@45106
   122
  FOF |
blanchet@45106
   123
  TFF |
blanchet@45106
   124
  THF of thf_flavor
blanchet@45106
   125
blanchet@43396
   126
datatype formula_kind = Axiom | Definition | Lemma | Hypothesis | Conjecture
blanchet@43398
   127
datatype 'a problem_line =
blanchet@43804
   128
  Decl of string * 'a * 'a ho_type |
nik@44535
   129
  Formula of string * formula_kind * ('a, 'a ho_type, ('a, 'a ho_type) ho_term) formula
nik@44535
   130
             * (string, string ho_type) ho_term option * (string, string ho_type) ho_term option
blanchet@37643
   131
type 'a problem = (string * 'a problem_line list) list
blanchet@37643
   132
blanchet@43587
   133
(* official TPTP syntax *)
blanchet@43809
   134
val tptp_cnf = "cnf"
blanchet@43809
   135
val tptp_fof = "fof"
blanchet@43809
   136
val tptp_tff = "tff"
blanchet@43809
   137
val tptp_thf = "thf"
blanchet@43808
   138
val tptp_has_type = ":"
blanchet@43803
   139
val tptp_type_of_types = "$tType"
blanchet@43803
   140
val tptp_bool_type = "$o"
blanchet@43803
   141
val tptp_individual_type = "$i"
blanchet@43804
   142
val tptp_fun_type = ">"
blanchet@43839
   143
val tptp_product_type = "*"
blanchet@43809
   144
val tptp_forall = "!"
nik@44537
   145
val tptp_ho_forall = "!!"
blanchet@43809
   146
val tptp_exists = "?"
nik@44537
   147
val tptp_ho_exists = "??"
blanchet@43809
   148
val tptp_not = "~"
blanchet@43809
   149
val tptp_and = "&"
blanchet@43809
   150
val tptp_or = "|"
blanchet@43809
   151
val tptp_implies = "=>"
blanchet@43809
   152
val tptp_if = "<="
blanchet@43809
   153
val tptp_iff = "<=>"
blanchet@43809
   154
val tptp_not_iff = "<~>"
blanchet@43809
   155
val tptp_app = "@"
blanchet@43809
   156
val tptp_not_infix = "!"
blanchet@43809
   157
val tptp_equal = "="
blanchet@43841
   158
val tptp_old_equal = "equal"
blanchet@43807
   159
val tptp_false = "$false"
blanchet@43807
   160
val tptp_true = "$true"
blanchet@43841
   161
val tptp_empty_list = "[]"
blanchet@43587
   162
blanchet@43841
   163
fun is_tptp_equal s = (s = tptp_equal orelse s = tptp_old_equal)
blanchet@43841
   164
fun is_built_in_tptp_symbol s =
blanchet@43841
   165
  s = tptp_old_equal orelse not (Char.isAlpha (String.sub (s, 0)))
blanchet@43839
   166
fun is_tptp_variable s = Char.isUpper (String.sub (s, 0))
blanchet@43839
   167
val is_tptp_user_symbol = not o (is_tptp_variable orf is_built_in_tptp_symbol)
blanchet@43780
   168
blanchet@43939
   169
fun raw_polarities_of_conn ANot = (SOME false, NONE)
blanchet@43939
   170
  | raw_polarities_of_conn AAnd = (SOME true, SOME true)
blanchet@43939
   171
  | raw_polarities_of_conn AOr = (SOME true, SOME true)
blanchet@43939
   172
  | raw_polarities_of_conn AImplies = (SOME false, SOME true)
blanchet@43939
   173
  | raw_polarities_of_conn AIff = (NONE, NONE)
blanchet@43939
   174
fun polarities_of_conn NONE = K (NONE, NONE)
blanchet@43939
   175
  | polarities_of_conn (SOME pos) =
blanchet@43939
   176
    raw_polarities_of_conn #> not pos ? pairself (Option.map not)
blanchet@43939
   177
blanchet@43783
   178
fun mk_anot (AConn (ANot, [phi])) = phi
blanchet@43783
   179
  | mk_anot phi = AConn (ANot, [phi])
blanchet@43783
   180
fun mk_aconn c phi1 phi2 = AConn (c, [phi1, phi2])
blanchet@43783
   181
blanchet@43839
   182
fun aconn_fold pos f (ANot, [phi]) = f (Option.map not pos) phi
blanchet@43839
   183
  | aconn_fold pos f (AImplies, [phi1, phi2]) =
blanchet@43839
   184
    f (Option.map not pos) phi1 #> f pos phi2
blanchet@43839
   185
  | aconn_fold pos f (AAnd, phis) = fold (f pos) phis
blanchet@43839
   186
  | aconn_fold pos f (AOr, phis) = fold (f pos) phis
blanchet@43839
   187
  | aconn_fold _ f (_, phis) = fold (f NONE) phis
blanchet@43839
   188
blanchet@43839
   189
fun aconn_map pos f (ANot, [phi]) = AConn (ANot, [f (Option.map not pos) phi])
blanchet@43839
   190
  | aconn_map pos f (AImplies, [phi1, phi2]) =
blanchet@43839
   191
    AConn (AImplies, [f (Option.map not pos) phi1, f pos phi2])
blanchet@43839
   192
  | aconn_map pos f (AAnd, phis) = AConn (AAnd, map (f pos) phis)
blanchet@43839
   193
  | aconn_map pos f (AOr, phis) = AConn (AOr, map (f pos) phis)
blanchet@43839
   194
  | aconn_map _ f (c, phis) = AConn (c, map (f NONE) phis)
blanchet@43839
   195
blanchet@43839
   196
fun formula_fold pos f =
blanchet@43839
   197
  let
blanchet@43839
   198
    fun aux pos (AQuant (_, _, phi)) = aux pos phi
blanchet@43839
   199
      | aux pos (AConn conn) = aconn_fold pos aux conn
blanchet@43839
   200
      | aux pos (AAtom tm) = f pos tm
blanchet@43839
   201
  in aux pos end
blanchet@43839
   202
blanchet@43785
   203
fun formula_map f (AQuant (q, xs, phi)) = AQuant (q, xs, formula_map f phi)
blanchet@43785
   204
  | formula_map f (AConn (c, phis)) = AConn (c, map (formula_map f) phis)
blanchet@43785
   205
  | formula_map f (AAtom tm) = AAtom (f tm)
blanchet@43785
   206
blanchet@45106
   207
fun is_format_thf (THF _) = true
blanchet@45106
   208
  | is_format_thf _ = false
blanchet@45106
   209
fun is_format_typed TFF = true
blanchet@45106
   210
  | is_format_typed (THF _) = true
blanchet@45106
   211
  | is_format_typed _ = false
blanchet@43839
   212
blanchet@38854
   213
fun string_for_kind Axiom = "axiom"
blanchet@42640
   214
  | string_for_kind Definition = "definition"
blanchet@42640
   215
  | string_for_kind Lemma = "lemma"
blanchet@38854
   216
  | string_for_kind Hypothesis = "hypothesis"
blanchet@38854
   217
  | string_for_kind Conjecture = "conjecture"
blanchet@38854
   218
blanchet@43804
   219
fun strip_tff_type (AFun (AType s, ty)) = strip_tff_type ty |>> cons s
blanchet@43804
   220
  | strip_tff_type (AFun (AFun _, _)) =
blanchet@43804
   221
    raise Fail "unexpected higher-order type in first-order format"
blanchet@43804
   222
  | strip_tff_type (AType s) = ([], s)
blanchet@43804
   223
blanchet@45106
   224
fun string_for_type (THF _) ty =
blanchet@43804
   225
    let
blanchet@43804
   226
      fun aux _ (AType s) = s
blanchet@43804
   227
        | aux rhs (AFun (ty1, ty2)) =
blanchet@43804
   228
          aux false ty1 ^ " " ^ tptp_fun_type ^ " " ^ aux true ty2
blanchet@43804
   229
          |> not rhs ? enclose "(" ")"
blanchet@43804
   230
    in aux true ty end
blanchet@43804
   231
  | string_for_type TFF ty =
blanchet@43804
   232
    (case strip_tff_type ty of
blanchet@43804
   233
       ([], s) => s
blanchet@43804
   234
     | ([s'], s) => s' ^ " " ^ tptp_fun_type ^ " " ^ s
blanchet@43809
   235
     | (ss, s) =>
blanchet@43839
   236
       "(" ^ space_implode (" " ^ tptp_product_type ^ " ") ss ^ ") " ^
blanchet@43835
   237
       tptp_fun_type ^ " " ^ s)
blanchet@43804
   238
  | string_for_type _ _ = raise Fail "unexpected type in untyped format"
blanchet@43804
   239
blanchet@43809
   240
fun string_for_quantifier AForall = tptp_forall
blanchet@43809
   241
  | string_for_quantifier AExists = tptp_exists
blanchet@43804
   242
blanchet@43808
   243
fun string_for_connective ANot = tptp_not
blanchet@43809
   244
  | string_for_connective AAnd = tptp_and
blanchet@43809
   245
  | string_for_connective AOr = tptp_or
blanchet@43809
   246
  | string_for_connective AImplies = tptp_implies
blanchet@43809
   247
  | string_for_connective AIff = tptp_iff
blanchet@43804
   248
blanchet@43803
   249
fun string_for_bound_var format (s, ty) =
blanchet@45106
   250
  s ^ (if is_format_typed format then
blanchet@43809
   251
         " " ^ tptp_has_type ^ " " ^
blanchet@43804
   252
         string_for_type format (ty |> the_default (AType tptp_individual_type))
blanchet@43804
   253
       else
blanchet@43804
   254
         "")
blanchet@43804
   255
blanchet@44857
   256
fun string_for_term _ (ATerm (s, [])) = s
blanchet@44857
   257
  | string_for_term format (ATerm (s, ts)) =
blanchet@44857
   258
    if s = tptp_empty_list then
blanchet@44857
   259
      (* used for lists in the optional "source" field of a derivation *)
blanchet@44857
   260
      "[" ^ commas (map (string_for_term format) ts) ^ "]"
blanchet@44857
   261
    else if is_tptp_equal s then
blanchet@44857
   262
      space_implode (" " ^ tptp_equal ^ " ") (map (string_for_term format) ts)
blanchet@45106
   263
      |> is_format_thf format ? enclose "(" ")"
blanchet@44857
   264
    else
blanchet@44857
   265
      (case (s = tptp_ho_forall orelse s = tptp_ho_exists, ts) of
blanchet@44857
   266
         (true, [AAbs ((s', ty), tm)]) =>
blanchet@44858
   267
         (* Use syntactic sugar "!" and "?" instead of "!!" and "??" whenever
blanchet@44858
   268
            possible, to work around LEO-II 1.2.8 parser limitation. *)
blanchet@44857
   269
         string_for_formula format
blanchet@44857
   270
             (AQuant (if s = tptp_ho_forall then AForall else AExists,
blanchet@44857
   271
                      [(s', SOME ty)], AAtom tm))
blanchet@44857
   272
       | _ =>
blanchet@44857
   273
         let val ss = map (string_for_term format) ts in
blanchet@45106
   274
           if is_format_thf format then
blanchet@44857
   275
             "(" ^ space_implode (" " ^ tptp_app ^ " ") (s :: ss) ^ ")"
blanchet@44857
   276
           else
blanchet@44857
   277
             s ^ "(" ^ commas ss ^ ")"
blanchet@44857
   278
         end)
blanchet@45106
   279
  | string_for_term (format as THF _) (AAbs ((s, ty), tm)) =
blanchet@45106
   280
    "(^[" ^ s ^ " : " ^ string_for_type format ty ^ "] : " ^
blanchet@45106
   281
    string_for_term format tm ^ ")"
blanchet@44857
   282
  | string_for_term _ _ = raise Fail "unexpected term in first-order format"
blanchet@44857
   283
and string_for_formula format (AQuant (q, xs, phi)) =
blanchet@43815
   284
    string_for_quantifier q ^
blanchet@43587
   285
    "[" ^ commas (map (string_for_bound_var format) xs) ^ "] : " ^
blanchet@43815
   286
    string_for_formula format phi
blanchet@43815
   287
    |> enclose "(" ")"
blanchet@43841
   288
  | string_for_formula format
blanchet@43841
   289
        (AConn (ANot, [AAtom (ATerm ("=" (* tptp_equal *), ts))])) =
blanchet@43809
   290
    space_implode (" " ^ tptp_not_infix ^ tptp_equal ^ " ")
blanchet@43809
   291
                  (map (string_for_term format) ts)
blanchet@45106
   292
    |> is_format_thf format ? enclose "(" ")"
blanchet@43587
   293
  | string_for_formula format (AConn (c, [phi])) =
blanchet@43815
   294
    string_for_connective c ^ " " ^
blanchet@45106
   295
    (string_for_formula format phi |> is_format_thf format ? enclose "(" ")")
blanchet@43815
   296
    |> enclose "(" ")"
blanchet@43587
   297
  | string_for_formula format (AConn (c, phis)) =
blanchet@43815
   298
    space_implode (" " ^ string_for_connective c ^ " ")
blanchet@43815
   299
                  (map (string_for_formula format) phis)
blanchet@43815
   300
    |> enclose "(" ")"
blanchet@43803
   301
  | string_for_formula format (AAtom tm) = string_for_term format tm
blanchet@38198
   302
blanchet@44558
   303
fun the_source (SOME source) = source
blanchet@44558
   304
  | the_source NONE =
blanchet@44558
   305
    ATerm ("inference",
blanchet@44558
   306
           ATerm ("isabelle", []) :: replicate 2 (ATerm ("[]", [])))
blanchet@43510
   307
blanchet@43933
   308
fun string_for_format CNF = tptp_cnf
blanchet@43933
   309
  | string_for_format CNF_UEQ = tptp_cnf
blanchet@43809
   310
  | string_for_format FOF = tptp_fof
blanchet@43809
   311
  | string_for_format TFF = tptp_tff
blanchet@45106
   312
  | string_for_format (THF _) = tptp_thf
blanchet@43803
   313
blanchet@43804
   314
fun string_for_problem_line format (Decl (ident, sym, ty)) =
blanchet@43803
   315
    string_for_format format ^ "(" ^ ident ^ ", type,\n    " ^ sym ^ " : " ^
blanchet@43804
   316
    string_for_type format ty ^ ").\n"
blanchet@43780
   317
  | string_for_problem_line format (Formula (ident, kind, phi, source, info)) =
blanchet@43803
   318
    string_for_format format ^ "(" ^ ident ^ ", " ^ string_for_kind kind ^
blanchet@43803
   319
    ",\n    (" ^ string_for_formula format phi ^ ")" ^
blanchet@43780
   320
    (case (source, info) of
blanchet@43580
   321
       (NONE, NONE) => ""
blanchet@43803
   322
     | (SOME tm, NONE) => ", " ^ string_for_term format tm
blanchet@43580
   323
     | (_, SOME tm) =>
blanchet@44558
   324
       ", " ^ string_for_term format (the_source source) ^
blanchet@43803
   325
       ", " ^ string_for_term format tm) ^ ").\n"
blanchet@44065
   326
fun tptp_lines_for_atp_problem format problem =
blanchet@37643
   327
  "% This file was generated by Isabelle (most likely Sledgehammer)\n\
blanchet@37643
   328
  \% " ^ timestamp () ^ "\n" ::
blanchet@37643
   329
  maps (fn (_, []) => []
blanchet@37643
   330
         | (heading, lines) =>
wenzelm@41739
   331
           "\n% " ^ heading ^ " (" ^ string_of_int (length lines) ^ ")\n" ::
blanchet@43580
   332
           map (string_for_problem_line format) lines)
blanchet@38854
   333
       problem
blanchet@37643
   334
blanchet@43780
   335
blanchet@43939
   336
(** CNF (Metis) and CNF UEQ (Waldmeister) **)
blanchet@43780
   337
blanchet@43780
   338
fun is_problem_line_negated (Formula (_, _, AConn (ANot, _), _, _)) = true
blanchet@43780
   339
  | is_problem_line_negated _ = false
blanchet@43780
   340
blanchet@44034
   341
fun is_problem_line_cnf_ueq (Formula (_, _, AAtom (ATerm ((s, _), _)), _, _)) =
blanchet@44034
   342
    is_tptp_equal s
blanchet@43780
   343
  | is_problem_line_cnf_ueq _ = false
blanchet@43780
   344
blanchet@43785
   345
fun open_conjecture_term (ATerm ((s, s'), tms)) =
nik@44535
   346
    ATerm (if is_tptp_variable s then (s |> Name.desymbolize false, s')
nik@44535
   347
           else (s, s'), tms |> map open_conjecture_term)
nik@44535
   348
  | open_conjecture_term _ = raise Fail "unexpected higher-order term"
blanchet@43939
   349
fun open_formula conj =
blanchet@43939
   350
  let
blanchet@44034
   351
    (* We are conveniently assuming that all bound variable names are
blanchet@44034
   352
       distinct, which should be the case for the formulas we generate. *)
blanchet@44034
   353
    fun opn (pos as SOME true) (AQuant (AForall, _, phi)) = opn pos phi
blanchet@44034
   354
      | opn (pos as SOME false) (AQuant (AExists, _, phi)) = opn pos phi
blanchet@43939
   355
      | opn pos (AConn (ANot, [phi])) = mk_anot (opn (Option.map not pos) phi)
blanchet@43939
   356
      | opn pos (AConn (c, [phi1, phi2])) =
blanchet@43939
   357
        let val (pos1, pos2) = polarities_of_conn pos c in
blanchet@43939
   358
          AConn (c, [opn pos1 phi1, opn pos2 phi2])
blanchet@43939
   359
        end
blanchet@43939
   360
      | opn _ (AAtom t) = AAtom (t |> conj ? open_conjecture_term)
blanchet@44283
   361
      | opn _ phi = phi
blanchet@43939
   362
  in opn (SOME (not conj)) end
blanchet@43785
   363
fun open_formula_line (Formula (ident, kind, phi, source, info)) =
blanchet@43785
   364
    Formula (ident, kind, open_formula (kind = Conjecture) phi, source, info)
blanchet@43785
   365
  | open_formula_line line = line
blanchet@43780
   366
blanchet@43780
   367
fun negate_conjecture_line (Formula (ident, Conjecture, phi, source, info)) =
blanchet@43783
   368
    Formula (ident, Hypothesis, mk_anot phi, source, info)
blanchet@43780
   369
  | negate_conjecture_line line = line
blanchet@43780
   370
blanchet@43939
   371
exception CLAUSIFY of unit
blanchet@43939
   372
blanchet@43967
   373
(* This "clausification" only expands syntactic sugar, such as "phi => psi" to
blanchet@43967
   374
   "~ phi | psi" and "phi <=> psi" to "~ phi | psi" and "~ psi | phi". We don't
blanchet@43967
   375
   attempt to distribute conjunctions over disjunctions. *)
blanchet@44034
   376
fun clausify_formula pos (phi as AAtom _) = [phi |> not pos ? mk_anot]
blanchet@44034
   377
  | clausify_formula pos (AConn (ANot, [phi])) = clausify_formula (not pos) phi
blanchet@44034
   378
  | clausify_formula true (AConn (AOr, [phi1, phi2])) =
blanchet@44034
   379
    (phi1, phi2) |> pairself (clausify_formula true)
blanchet@44034
   380
                 |> uncurry (map_product (mk_aconn AOr))
blanchet@44034
   381
  | clausify_formula false (AConn (AAnd, [phi1, phi2])) =
blanchet@44034
   382
    (phi1, phi2) |> pairself (clausify_formula false)
blanchet@44034
   383
                 |> uncurry (map_product (mk_aconn AOr))
blanchet@44034
   384
  | clausify_formula true (AConn (AImplies, [phi1, phi2])) =
blanchet@44034
   385
    clausify_formula true (AConn (AOr, [mk_anot phi1, phi2]))
blanchet@44034
   386
  | clausify_formula true (AConn (AIff, phis)) =
blanchet@44034
   387
    clausify_formula true (AConn (AImplies, phis)) @
blanchet@44034
   388
    clausify_formula true (AConn (AImplies, rev phis))
blanchet@44034
   389
  | clausify_formula _ _ = raise CLAUSIFY ()
blanchet@43939
   390
blanchet@43939
   391
fun clausify_formula_line (Formula (ident, kind, phi, source, info)) =
blanchet@43967
   392
    let
blanchet@43967
   393
      val (n, phis) = phi |> try (clausify_formula true) |> these |> `length
blanchet@43967
   394
    in
blanchet@43967
   395
      map2 (fn phi => fn j =>
blanchet@44153
   396
               Formula (ident ^ replicate_string (j - 1) "x", kind, phi, source,
blanchet@44153
   397
                        info))
blanchet@43967
   398
           phis (1 upto n)
blanchet@43967
   399
    end
blanchet@43967
   400
  | clausify_formula_line _ = []
blanchet@43939
   401
blanchet@43939
   402
fun ensure_cnf_problem_line line =
blanchet@43939
   403
  line |> open_formula_line |> negate_conjecture_line |> clausify_formula_line
blanchet@43939
   404
blanchet@43939
   405
fun ensure_cnf_problem problem =
blanchet@43967
   406
  problem |> map (apsnd (maps ensure_cnf_problem_line))
blanchet@43933
   407
blanchet@43803
   408
fun filter_cnf_ueq_problem problem =
blanchet@43803
   409
  problem
blanchet@43803
   410
  |> map (apsnd (map open_formula_line
blanchet@43803
   411
                 #> filter is_problem_line_cnf_ueq
blanchet@43803
   412
                 #> map negate_conjecture_line))
blanchet@43803
   413
  |> (fn problem =>
blanchet@43780
   414
         let
blanchet@44688
   415
           val lines = problem |> maps snd
blanchet@44688
   416
           val conjs = lines |> filter is_problem_line_negated
blanchet@44688
   417
         in if length conjs = 1 andalso conjs <> lines then problem else [] end)
blanchet@38251
   418
blanchet@37643
   419
blanchet@43839
   420
(** Symbol declarations **)
blanchet@43839
   421
blanchet@43839
   422
(* TFF allows implicit declarations of types, function symbols, and predicate
blanchet@43839
   423
   symbols (with "$i" as the type of individuals), but some provers (e.g.,
blanchet@43839
   424
   SNARK) require explicit declarations. The situation is similar for THF. *)
blanchet@43839
   425
blanchet@43839
   426
val atype_of_types = AType (`I tptp_type_of_types)
blanchet@43839
   427
val bool_atype = AType (`I tptp_bool_type)
blanchet@43839
   428
val individual_atype = AType (`I tptp_individual_type)
blanchet@43839
   429
blanchet@43839
   430
fun default_type pred_sym =
blanchet@43839
   431
  let
blanchet@43839
   432
    fun typ 0 = if pred_sym then bool_atype else individual_atype
blanchet@43839
   433
      | typ ary = AFun (individual_atype, typ (ary - 1))
blanchet@43839
   434
  in typ end
blanchet@43839
   435
blanchet@43839
   436
fun add_declared_syms_in_problem_line (Decl (_, sym, _)) = insert (op =) sym
blanchet@43839
   437
  | add_declared_syms_in_problem_line _ = I
blanchet@43839
   438
fun declared_syms_in_problem problem =
blanchet@43839
   439
  fold (fold add_declared_syms_in_problem_line o snd) problem []
blanchet@43839
   440
blanchet@43839
   441
fun undeclared_syms_in_problem declared problem =
blanchet@43839
   442
  let
blanchet@43839
   443
    fun do_sym name ty =
blanchet@43839
   444
      if member (op =) declared name then I else AList.default (op =) (name, ty)
blanchet@43839
   445
    fun do_type (AFun (ty1, ty2)) = fold do_type [ty1, ty2]
blanchet@43839
   446
      | do_type (AType name) = do_sym name (K atype_of_types)
blanchet@43839
   447
    fun do_term pred_sym (ATerm (name as (s, _), tms)) =
nik@44535
   448
        is_tptp_user_symbol s
nik@44535
   449
        ? do_sym name (fn _ => default_type pred_sym (length tms))
nik@44535
   450
        #> fold (do_term false) tms
nik@44535
   451
      | do_term _ (AAbs ((_, ty), tm)) = do_type ty #> do_term false tm
blanchet@43839
   452
    fun do_formula (AQuant (_, xs, phi)) =
blanchet@43839
   453
        fold do_type (map_filter snd xs) #> do_formula phi
blanchet@43839
   454
      | do_formula (AConn (_, phis)) = fold do_formula phis
blanchet@43839
   455
      | do_formula (AAtom tm) = do_term true tm
blanchet@43839
   456
    fun do_problem_line (Decl (_, _, ty)) = do_type ty
blanchet@43839
   457
      | do_problem_line (Formula (_, _, phi, _, _)) = do_formula phi
blanchet@43839
   458
  in
blanchet@43839
   459
    fold (fold do_problem_line o snd) problem []
blanchet@43839
   460
    |> filter_out (is_built_in_tptp_symbol o fst o fst)
blanchet@43839
   461
  end
blanchet@43839
   462
blanchet@43839
   463
fun declare_undeclared_syms_in_atp_problem prefix heading problem =
blanchet@43839
   464
  let
blanchet@43839
   465
    fun decl_line (x as (s, _), ty) = Decl (prefix ^ s, x, ty ())
blanchet@43839
   466
    val declared = problem |> declared_syms_in_problem
blanchet@43839
   467
    val decls =
blanchet@43839
   468
      problem |> undeclared_syms_in_problem declared
blanchet@43839
   469
              |> sort_wrt (fst o fst)
blanchet@43839
   470
              |> map decl_line
blanchet@43839
   471
  in (heading, decls) :: problem end
blanchet@43839
   472
blanchet@37643
   473
(** Nice names **)
blanchet@37643
   474
blanchet@37624
   475
fun empty_name_pool readable_names =
blanchet@37643
   476
  if readable_names then SOME (Symtab.empty, Symtab.empty) else NONE
blanchet@37624
   477
blanchet@37624
   478
fun pool_fold f xs z = pair z #> fold_rev (fn x => uncurry (f x)) xs
blanchet@37624
   479
fun pool_map f xs =
blanchet@37624
   480
  pool_fold (fn x => fn ys => fn pool => f x pool |>> (fn y => y :: ys)) xs []
blanchet@37624
   481
blanchet@43088
   482
val no_qualifiers =
blanchet@43088
   483
  let
blanchet@43088
   484
    fun skip [] = []
blanchet@43088
   485
      | skip (#"." :: cs) = skip cs
blanchet@43088
   486
      | skip (c :: cs) = if Char.isAlphaNum c then skip cs else c :: keep cs
blanchet@43088
   487
    and keep [] = []
blanchet@43088
   488
      | keep (#"." :: cs) = skip cs
blanchet@43088
   489
      | keep (c :: cs) = c :: keep cs
blanchet@43088
   490
  in String.explode #> rev #> keep #> rev #> String.implode end
blanchet@43088
   491
blanchet@43626
   492
(* Long names can slow down the ATPs. *)
blanchet@43589
   493
val max_readable_name_size = 20
blanchet@43438
   494
blanchet@43841
   495
(* "equal" is reserved by some ATPs. "op" is also reserved, to avoid the
blanchet@43841
   496
   unreadable "op_1", "op_2", etc., in the problem files. "eq" is reserved to
blanchet@43841
   497
   ensure that "HOL.eq" is correctly mapped to equality (not clear whether this
blanchet@43841
   498
   is still necessary). *)
blanchet@43841
   499
val reserved_nice_names = [tptp_old_equal, "op", "eq"]
blanchet@43780
   500
blanchet@37624
   501
fun readable_name full_name s =
blanchet@37643
   502
  if s = full_name then
blanchet@37643
   503
    s
blanchet@37643
   504
  else
blanchet@43438
   505
    s |> no_qualifiers
blanchet@43438
   506
      |> Name.desymbolize (Char.isUpper (String.sub (full_name, 0)))
blanchet@43454
   507
      |> (fn s =>
blanchet@43530
   508
             if size s > max_readable_name_size then
blanchet@43530
   509
               String.substring (s, 0, max_readable_name_size div 2 - 4) ^
blanchet@44691
   510
               string_of_int (hash_string full_name) ^
blanchet@43530
   511
               String.extract (s, size s - max_readable_name_size div 2 + 4,
blanchet@43530
   512
                               NONE)
blanchet@43454
   513
             else
blanchet@43454
   514
               s)
blanchet@43438
   515
      |> (fn s => if member (op =) reserved_nice_names s then full_name else s)
blanchet@37624
   516
blanchet@37624
   517
fun nice_name (full_name, _) NONE = (full_name, NONE)
blanchet@37624
   518
  | nice_name (full_name, desired_name) (SOME the_pool) =
blanchet@43839
   519
    if is_built_in_tptp_symbol full_name then
blanchet@39630
   520
      (full_name, SOME the_pool)
blanchet@39630
   521
    else case Symtab.lookup (fst the_pool) full_name of
blanchet@37624
   522
      SOME nice_name => (nice_name, SOME the_pool)
blanchet@37624
   523
    | NONE =>
blanchet@37624
   524
      let
blanchet@37624
   525
        val nice_prefix = readable_name full_name desired_name
blanchet@37624
   526
        fun add j =
blanchet@37624
   527
          let
blanchet@43515
   528
            val nice_name =
blanchet@43783
   529
              nice_prefix ^ (if j = 0 then "" else "_" ^ string_of_int j)
blanchet@37624
   530
          in
blanchet@37624
   531
            case Symtab.lookup (snd the_pool) nice_name of
blanchet@37624
   532
              SOME full_name' =>
blanchet@37624
   533
              if full_name = full_name' then (nice_name, the_pool)
blanchet@37624
   534
              else add (j + 1)
blanchet@37624
   535
            | NONE =>
blanchet@37624
   536
              (nice_name,
blanchet@37624
   537
               (Symtab.update_new (full_name, nice_name) (fst the_pool),
blanchet@37624
   538
                Symtab.update_new (nice_name, full_name) (snd the_pool)))
blanchet@37624
   539
          end
blanchet@37624
   540
      in add 0 |> apsnd SOME end
blanchet@37624
   541
blanchet@43804
   542
fun nice_type (AType name) = nice_name name #>> AType
blanchet@43804
   543
  | nice_type (AFun (ty1, ty2)) = nice_type ty1 ##>> nice_type ty2 #>> AFun
nik@44535
   544
fun nice_term (ATerm (name, ts)) =
nik@44535
   545
    nice_name name ##>> pool_map nice_term ts #>> ATerm
nik@44535
   546
  | nice_term (AAbs ((name, ty), tm)) =
nik@44535
   547
    nice_name name ##>> nice_type ty ##>> nice_term tm #>> AAbs
blanchet@38198
   548
fun nice_formula (AQuant (q, xs, phi)) =
blanchet@43397
   549
    pool_map nice_name (map fst xs)
blanchet@43397
   550
    ##>> pool_map (fn NONE => pair NONE
blanchet@43804
   551
                    | SOME ty => nice_type ty #>> SOME) (map snd xs)
blanchet@43397
   552
    ##>> nice_formula phi
blanchet@43397
   553
    #>> (fn ((ss, ts), phi) => AQuant (q, ss ~~ ts, phi))
blanchet@38198
   554
  | nice_formula (AConn (c, phis)) =
blanchet@38198
   555
    pool_map nice_formula phis #>> curry AConn c
blanchet@38280
   556
  | nice_formula (AAtom tm) = nice_term tm #>> AAtom
blanchet@43804
   557
fun nice_problem_line (Decl (ident, sym, ty)) =
blanchet@43839
   558
    nice_name sym ##>> nice_type ty #>> (fn (sym, ty) => Decl (ident, sym, ty))
blanchet@43780
   559
  | nice_problem_line (Formula (ident, kind, phi, source, info)) =
blanchet@43780
   560
    nice_formula phi #>> (fn phi => Formula (ident, kind, phi, source, info))
blanchet@38171
   561
fun nice_problem problem =
blanchet@37643
   562
  pool_map (fn (heading, lines) =>
blanchet@38171
   563
               pool_map nice_problem_line lines #>> pair heading) problem
blanchet@39692
   564
fun nice_atp_problem readable_names problem =
blanchet@38251
   565
  nice_problem problem (empty_name_pool readable_names)
blanchet@37509
   566
blanchet@37509
   567
end;