src/HOL/Tools/res_hol_clause.ML
author paulson
Tue Aug 21 18:27:14 2007 +0200 (2007-08-21)
changeset 24385 ab62948281a9
parent 24323 9aa7b5708eac
child 24937 340523598914
permissions -rw-r--r--
Deleted the partially-typed translation and the combinator code.
Minimize_applies now uses the same translation code, which handles both cases anyway.
     1 (* ID: $Id$
     2    Author: Jia Meng, NICTA
     3 
     4 FOL clauses translated from HOL formulae.
     5 
     6 The combinator code needs to be deleted after the translation paper has been published.
     7 It cannot be used with proof reconstruction because combinators are not introduced by proof.
     8 The Turner combinators (B', C', S') yield no improvement and should be deleted.
     9 *)
    10 
    11 signature RES_HOL_CLAUSE =
    12 sig
    13   val ext: thm
    14   val comb_I: thm
    15   val comb_K: thm
    16   val comb_B: thm
    17   val comb_C: thm
    18   val comb_S: thm
    19   datatype type_level = T_FULL | T_CONST
    20   val typ_level: type_level ref
    21   val minimize_applies: bool ref
    22   type axiom_name = string
    23   type polarity = bool
    24   type clause_id = int
    25   datatype combterm =
    26       CombConst of string * ResClause.fol_type * ResClause.fol_type list (*Const and Free*)
    27     | CombVar of string * ResClause.fol_type
    28     | CombApp of combterm * combterm
    29   datatype literal = Literal of polarity * combterm
    30   val strip_comb: combterm -> combterm * combterm list
    31   val literals_of_term: theory -> term -> literal list * (ResClause.typ_var * sort) list
    32   val tptp_write_file: theory -> bool -> thm list -> string ->
    33     (thm * (axiom_name * clause_id)) list * ResClause.classrelClause list *
    34       ResClause.arityClause list -> string list -> axiom_name list
    35   val dfg_write_file: theory -> bool -> thm list -> string ->
    36     (thm * (axiom_name * clause_id)) list * ResClause.classrelClause list *
    37       ResClause.arityClause list -> string list -> axiom_name list
    38 end
    39 
    40 structure ResHolClause: RES_HOL_CLAUSE =
    41 struct
    42 
    43 structure RC = ResClause;
    44 
    45 (* theorems for combinators and function extensionality *)
    46 val ext = thm "HOL.ext";
    47 val comb_I = thm "ATP_Linkup.COMBI_def";
    48 val comb_K = thm "ATP_Linkup.COMBK_def";
    49 val comb_B = thm "ATP_Linkup.COMBB_def";
    50 val comb_C = thm "ATP_Linkup.COMBC_def";
    51 val comb_S = thm "ATP_Linkup.COMBS_def";
    52 val comb_B' = thm "ATP_Linkup.COMBB'_def";
    53 val comb_C' = thm "ATP_Linkup.COMBC'_def";
    54 val comb_S' = thm "ATP_Linkup.COMBS'_def";
    55 val fequal_imp_equal = thm "ATP_Linkup.fequal_imp_equal";
    56 val equal_imp_fequal = thm "ATP_Linkup.equal_imp_fequal";
    57 
    58 
    59 (*The different translations of types*)
    60 datatype type_level = T_FULL | T_CONST;
    61 
    62 val typ_level = ref T_CONST;
    63 
    64 (*If true, each function will be directly applied to as many arguments as possible, avoiding
    65   use of the "apply" operator. Use of hBOOL is also minimized.*)
    66 val minimize_applies = ref true;
    67 
    68 val const_min_arity = ref (Symtab.empty : int Symtab.table);
    69 
    70 val const_needs_hBOOL = ref (Symtab.empty : bool Symtab.table);
    71 
    72 fun min_arity_of c = getOpt (Symtab.lookup(!const_min_arity) c, 0);
    73 
    74 (*True if the constant ever appears outside of the top-level position in literals.
    75   If false, the constant always receives all of its arguments and is used as a predicate.*)
    76 fun needs_hBOOL c = not (!minimize_applies) orelse
    77                     getOpt (Symtab.lookup(!const_needs_hBOOL) c, false);
    78 
    79 
    80 (******************************************************)
    81 (* data types for typed combinator expressions        *)
    82 (******************************************************)
    83 
    84 type axiom_name = string;
    85 type polarity = bool;
    86 type clause_id = int;
    87 
    88 datatype combterm = CombConst of string * RC.fol_type * RC.fol_type list (*Const and Free*)
    89                   | CombVar of string * RC.fol_type
    90                   | CombApp of combterm * combterm
    91 
    92 datatype literal = Literal of polarity * combterm;
    93 
    94 datatype clause =
    95          Clause of {clause_id: clause_id,
    96                     axiom_name: axiom_name,
    97                     th: thm,
    98                     kind: RC.kind,
    99                     literals: literal list,
   100                     ctypes_sorts: (RC.typ_var * Term.sort) list,
   101                     ctvar_type_literals: RC.type_literal list,
   102                     ctfree_type_literals: RC.type_literal list};
   103 
   104 
   105 (*********************************************************************)
   106 (* convert a clause with type Term.term to a clause with type clause *)
   107 (*********************************************************************)
   108 
   109 fun isFalse (Literal(pol, CombConst(c,_,_))) =
   110       (pol andalso c = "c_False") orelse
   111       (not pol andalso c = "c_True")
   112   | isFalse _ = false;
   113 
   114 fun isTrue (Literal (pol, CombConst(c,_,_))) =
   115       (pol andalso c = "c_True") orelse
   116       (not pol andalso c = "c_False")
   117   | isTrue _ = false;
   118 
   119 fun isTaut (Clause {literals,...}) = exists isTrue literals;
   120 
   121 fun type_of (Type (a, Ts)) =
   122       let val (folTypes,ts) = types_of Ts
   123       in  (RC.Comp(RC.make_fixed_type_const a, folTypes), ts)  end
   124   | type_of (tp as (TFree(a,s))) =
   125       (RC.AtomF (RC.make_fixed_type_var a), [RC.mk_typ_var_sort tp])
   126   | type_of (tp as (TVar(v,s))) =
   127       (RC.AtomV (RC.make_schematic_type_var v), [RC.mk_typ_var_sort tp])
   128 and types_of Ts =
   129       let val (folTyps,ts) = ListPair.unzip (map type_of Ts)
   130       in  (folTyps, RC.union_all ts)  end;
   131 
   132 (* same as above, but no gathering of sort information *)
   133 fun simp_type_of (Type (a, Ts)) =
   134       RC.Comp(RC.make_fixed_type_const a, map simp_type_of Ts)
   135   | simp_type_of (TFree (a,s)) = RC.AtomF(RC.make_fixed_type_var a)
   136   | simp_type_of (TVar (v,s)) = RC.AtomV(RC.make_schematic_type_var v);
   137 
   138 
   139 fun const_type_of thy (c,t) =
   140       let val (tp,ts) = type_of t
   141       in  (tp, ts, map simp_type_of (Sign.const_typargs thy (c,t))) end;
   142 
   143 (* convert a Term.term (with combinators) into a combterm, also accummulate sort info *)
   144 fun combterm_of thy (Const(c,t)) =
   145       let val (tp,ts,tvar_list) = const_type_of thy (c,t)
   146           val c' = CombConst(RC.make_fixed_const c, tp, tvar_list)
   147       in  (c',ts)  end
   148   | combterm_of thy (Free(v,t)) =
   149       let val (tp,ts) = type_of t
   150           val v' = if RC.isMeta v then CombVar(RC.make_schematic_var(v,0),tp)
   151                    else CombConst(RC.make_fixed_var v, tp, [])
   152       in  (v',ts)  end
   153   | combterm_of thy (Var(v,t)) =
   154       let val (tp,ts) = type_of t
   155           val v' = CombVar(RC.make_schematic_var v,tp)
   156       in  (v',ts)  end
   157   | combterm_of thy (P $ Q) =
   158       let val (P',tsP) = combterm_of thy P
   159           val (Q',tsQ) = combterm_of thy Q
   160       in  (CombApp(P',Q'), tsP union tsQ)  end
   161   | combterm_of thy (t as Abs _) = raise RC.CLAUSE("HOL CLAUSE",t);
   162 
   163 fun predicate_of thy ((Const("Not",_) $ P), polarity) = predicate_of thy (P, not polarity)
   164   | predicate_of thy (t,polarity) = (combterm_of thy t, polarity);
   165 
   166 fun literals_of_term1 thy args (Const("Trueprop",_) $ P) = literals_of_term1 thy args P
   167   | literals_of_term1 thy args (Const("op |",_) $ P $ Q) =
   168       literals_of_term1 thy (literals_of_term1 thy args P) Q
   169   | literals_of_term1 thy (lits,ts) P =
   170       let val ((pred,ts'),pol) = predicate_of thy (P,true)
   171       in
   172           (Literal(pol,pred)::lits, ts union ts')
   173       end;
   174 
   175 fun literals_of_term thy P = literals_of_term1 thy ([],[]) P;
   176 
   177 (* making axiom and conjecture clauses *)
   178 fun make_clause thy (clause_id,axiom_name,kind,th) =
   179     let val (lits,ctypes_sorts) = literals_of_term thy (prop_of th)
   180         val (ctvar_lits,ctfree_lits) = RC.add_typs_aux ctypes_sorts
   181     in
   182         if forall isFalse lits
   183         then error "Problem too trivial for resolution (empty clause)"
   184         else
   185             Clause {clause_id = clause_id, axiom_name = axiom_name, th = th, kind = kind,
   186                     literals = lits, ctypes_sorts = ctypes_sorts,
   187                     ctvar_type_literals = ctvar_lits,
   188                     ctfree_type_literals = ctfree_lits}
   189     end;
   190 
   191 
   192 fun add_axiom_clause thy ((th,(name,id)), pairs) =
   193   let val cls = make_clause thy (id, name, RC.Axiom, th)
   194   in
   195       if isTaut cls then pairs else (name,cls)::pairs
   196   end;
   197 
   198 fun make_axiom_clauses thy = foldl (add_axiom_clause thy) [];
   199 
   200 fun make_conjecture_clauses_aux _ _ [] = []
   201   | make_conjecture_clauses_aux thy n (th::ths) =
   202       make_clause thy (n,"conjecture", RC.Conjecture, th) ::
   203       make_conjecture_clauses_aux thy (n+1) ths;
   204 
   205 fun make_conjecture_clauses thy = make_conjecture_clauses_aux thy 0;
   206 
   207 
   208 (**********************************************************************)
   209 (* convert clause into ATP specific formats:                          *)
   210 (* TPTP used by Vampire and E                                         *)
   211 (* DFG used by SPASS                                                  *)
   212 (**********************************************************************)
   213 
   214 (*Result of a function type; no need to check that the argument type matches.*)
   215 fun result_type (RC.Comp ("tc_fun", [_, tp2])) = tp2
   216   | result_type _ = raise ERROR "result_type"
   217 
   218 fun type_of_combterm (CombConst(c,tp,_)) = tp
   219   | type_of_combterm (CombVar(v,tp)) = tp
   220   | type_of_combterm (CombApp(t1,t2)) = result_type (type_of_combterm t1);
   221 
   222 (*gets the head of a combinator application, along with the list of arguments*)
   223 fun strip_comb u =
   224     let fun stripc (CombApp(t,u), ts) = stripc (t, u::ts)
   225         |   stripc  x =  x
   226     in  stripc(u,[])  end;
   227 
   228 val type_wrapper = "ti";
   229 
   230 fun head_needs_hBOOL (CombConst(c,_,_)) = needs_hBOOL c
   231   | head_needs_hBOOL _ = true;
   232 
   233 fun wrap_type (s, tp) =
   234   if !typ_level=T_FULL then
   235       type_wrapper ^ RC.paren_pack [s, RC.string_of_fol_type tp]
   236   else s;
   237 
   238 fun apply ss = "hAPP" ^ RC.paren_pack ss;
   239 
   240 fun rev_apply (v, []) = v
   241   | rev_apply (v, arg::args) = apply [rev_apply (v, args), arg];
   242 
   243 fun string_apply (v, args) = rev_apply (v, rev args);
   244 
   245 (*Apply an operator to the argument strings, using either the "apply" operator or
   246   direct function application.*)
   247 fun string_of_applic (CombConst(c,tp,tvars), args) =
   248       let val c = if c = "equal" then "c_fequal" else c
   249           val nargs = min_arity_of c
   250           val args1 = List.take(args, nargs)
   251             handle Subscript => raise ERROR ("string_of_applic: " ^ c ^ " has arity " ^
   252                                              Int.toString nargs ^ " but is applied to " ^
   253                                              space_implode ", " args)
   254           val args2 = List.drop(args, nargs)
   255           val targs = if !typ_level = T_CONST then map RC.string_of_fol_type tvars
   256                       else []
   257       in
   258           string_apply (c ^ RC.paren_pack (args1@targs), args2)
   259       end
   260   | string_of_applic (CombVar(v,tp), args) = string_apply (v, args)
   261   | string_of_applic _ = raise ERROR "string_of_applic";
   262 
   263 fun wrap_type_if (head, s, tp) = if head_needs_hBOOL head then wrap_type (s, tp) else s;
   264 
   265 fun string_of_combterm t =
   266   let val (head, args) = strip_comb t
   267   in  wrap_type_if (head,
   268                     string_of_applic (head, map string_of_combterm args),
   269                     type_of_combterm t)
   270   end;
   271 
   272 (*Boolean-valued terms are here converted to literals.*)
   273 fun boolify t = "hBOOL" ^ RC.paren_pack [string_of_combterm t];
   274 
   275 fun string_of_predicate t =
   276   case t of
   277       (CombApp(CombApp(CombConst("equal",_,_), t1), t2)) =>
   278           (*DFG only: new TPTP prefers infix equality*)
   279           ("equal" ^ RC.paren_pack [string_of_combterm t1, string_of_combterm t2])
   280     | _ =>
   281           case #1 (strip_comb t) of
   282               CombConst(c,_,_) => if needs_hBOOL c then boolify t else string_of_combterm t
   283             | _ => boolify t;
   284 
   285 fun string_of_clausename (cls_id,ax_name) =
   286     RC.clause_prefix ^ RC.ascii_of ax_name ^ "_" ^ Int.toString cls_id;
   287 
   288 fun string_of_type_clsname (cls_id,ax_name,idx) =
   289     string_of_clausename (cls_id,ax_name) ^ "_tcs" ^ (Int.toString idx);
   290 
   291 
   292 (*** tptp format ***)
   293 
   294 fun tptp_of_equality pol (t1,t2) =
   295   let val eqop = if pol then " = " else " != "
   296   in  string_of_combterm t1 ^ eqop ^ string_of_combterm t2  end;
   297 
   298 fun tptp_literal (Literal(pol, CombApp(CombApp(CombConst("equal",_,_), t1), t2))) =
   299       tptp_of_equality pol (t1,t2)
   300   | tptp_literal (Literal(pol,pred)) =
   301       RC.tptp_sign pol (string_of_predicate pred);
   302 
   303 (*Given a clause, returns its literals paired with a list of literals concerning TFrees;
   304   the latter should only occur in conjecture clauses.*)
   305 fun tptp_type_lits (Clause cls) =
   306     let val lits = map tptp_literal (#literals cls)
   307         val ctvar_lits_strs = map RC.tptp_of_typeLit (#ctvar_type_literals cls)
   308         val ctfree_lits = map RC.tptp_of_typeLit (#ctfree_type_literals cls)
   309     in
   310         (ctvar_lits_strs @ lits, ctfree_lits)
   311     end;
   312 
   313 fun clause2tptp (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
   314     let val (lits,ctfree_lits) = tptp_type_lits cls
   315         val cls_str = RC.gen_tptp_cls(clause_id,axiom_name,kind,lits)
   316     in
   317         (cls_str,ctfree_lits)
   318     end;
   319 
   320 
   321 (*** dfg format ***)
   322 
   323 fun dfg_literal (Literal(pol,pred)) = RC.dfg_sign pol (string_of_predicate pred);
   324 
   325 fun dfg_clause_aux (Clause{literals, ctypes_sorts, ...}) =
   326   let val lits = map dfg_literal literals
   327       val (tvar_lits,tfree_lits) = RC.add_typs_aux ctypes_sorts
   328       val tvar_lits_strs = map RC.dfg_of_typeLit tvar_lits
   329       val tfree_lits = map RC.dfg_of_typeLit tfree_lits
   330   in
   331       (tvar_lits_strs @ lits, tfree_lits)
   332   end;
   333 
   334 fun get_uvars (CombConst _) vars = vars
   335   | get_uvars (CombVar(v,_)) vars = (v::vars)
   336   | get_uvars (CombApp(P,Q)) vars = get_uvars P (get_uvars Q vars);
   337 
   338 fun get_uvars_l (Literal(_,c)) = get_uvars c [];
   339 
   340 fun dfg_vars (Clause {literals,...}) = RC.union_all (map get_uvars_l literals);
   341 
   342 fun clause2dfg (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
   343     let val (lits,tfree_lits) = dfg_clause_aux cls
   344         val vars = dfg_vars cls
   345         val tvars = RC.get_tvar_strs ctypes_sorts
   346         val knd = RC.name_of_kind kind
   347         val lits_str = commas lits
   348         val cls_str = RC.gen_dfg_cls(clause_id, axiom_name, knd, lits_str, tvars@vars)
   349     in (cls_str, tfree_lits) end;
   350 
   351 (** For DFG format: accumulate function and predicate declarations **)
   352 
   353 fun addtypes tvars tab = foldl RC.add_foltype_funcs tab tvars;
   354 
   355 fun add_decls (CombConst(c,tp,tvars), (funcs,preds)) =
   356       if c = "equal" then (addtypes tvars funcs, preds)
   357       else
   358 	let val arity = min_arity_of c
   359 	    val ntys = if !typ_level = T_CONST then length tvars else 0
   360 	    val addit = Symtab.update(c, arity+ntys)
   361 	in
   362 	    if needs_hBOOL c then (addtypes tvars (addit funcs), preds)
   363 	    else (addtypes tvars funcs, addit preds)
   364 	end
   365   | add_decls (CombVar(_,ctp), (funcs,preds)) =
   366       (RC.add_foltype_funcs (ctp,funcs), preds)
   367   | add_decls (CombApp(P,Q),decls) = add_decls(P,add_decls (Q,decls));
   368 
   369 fun add_literal_decls (Literal(_,c), decls) = add_decls (c,decls);
   370 
   371 fun add_clause_decls (Clause {literals, ...}, decls) =
   372     foldl add_literal_decls decls literals
   373     handle Symtab.DUP a => raise ERROR ("function " ^ a ^ " has multiple arities")
   374 
   375 fun decls_of_clauses clauses arity_clauses =
   376   let val init_functab = Symtab.update (type_wrapper,2) (Symtab.update ("hAPP",2) RC.init_functab)
   377       val init_predtab = Symtab.update ("hBOOL",1) Symtab.empty
   378       val (functab,predtab) = (foldl add_clause_decls (init_functab, init_predtab) clauses)
   379   in
   380       (Symtab.dest (foldl RC.add_arityClause_funcs functab arity_clauses),
   381        Symtab.dest predtab)
   382   end;
   383 
   384 fun add_clause_preds (Clause {ctypes_sorts, ...}, preds) =
   385   foldl RC.add_type_sort_preds preds ctypes_sorts
   386   handle Symtab.DUP a => raise ERROR ("predicate " ^ a ^ " has multiple arities")
   387 
   388 (*Higher-order clauses have only the predicates hBOOL and type classes.*)
   389 fun preds_of_clauses clauses clsrel_clauses arity_clauses =
   390     Symtab.dest
   391         (foldl RC.add_classrelClause_preds
   392                (foldl RC.add_arityClause_preds
   393                       (foldl add_clause_preds Symtab.empty clauses)
   394                       arity_clauses)
   395                clsrel_clauses)
   396 
   397 
   398 (**********************************************************************)
   399 (* write clauses to files                                             *)
   400 (**********************************************************************)
   401 
   402 val init_counters =
   403     Symtab.make [("c_COMBI", 0), ("c_COMBK", 0),
   404                  ("c_COMBB", 0), ("c_COMBC", 0),
   405                  ("c_COMBS", 0), ("c_COMBB_e", 0),
   406                  ("c_COMBC_e", 0), ("c_COMBS_e", 0)];
   407 
   408 fun count_combterm (CombConst(c,tp,_), ct) =
   409      (case Symtab.lookup ct c of NONE => ct  (*no counter*)
   410                                | SOME n => Symtab.update (c,n+1) ct)
   411   | count_combterm (CombVar(v,tp), ct) = ct
   412   | count_combterm (CombApp(t1,t2), ct) = count_combterm(t1, count_combterm(t2, ct));
   413 
   414 fun count_literal (Literal(_,t), ct) = count_combterm(t,ct);
   415 
   416 fun count_clause (Clause{literals,...}, ct) = foldl count_literal ct literals;
   417 
   418 fun count_user_clause user_lemmas (Clause{axiom_name,literals,...}, ct) =
   419   if axiom_name mem_string user_lemmas then foldl count_literal ct literals
   420   else ct;
   421 
   422 val cnf_helper_thms = ResAxioms.cnf_rules_pairs o (map ResAxioms.pairname)
   423 
   424 fun get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas) =
   425   if isFO then []  (*first-order*)
   426   else
   427     let val ct0 = foldl count_clause init_counters conjectures
   428         val ct = foldl (count_user_clause user_lemmas) ct0 axclauses
   429         fun needed c = valOf (Symtab.lookup ct c) > 0
   430         val IK = if needed "c_COMBI" orelse needed "c_COMBK"
   431                  then (Output.debug (fn () => "Include combinator I K"); cnf_helper_thms [comb_I,comb_K])
   432                  else []
   433         val BC = if needed "c_COMBB" orelse needed "c_COMBC"
   434                  then (Output.debug (fn () => "Include combinator B C"); cnf_helper_thms [comb_B,comb_C])
   435                  else []
   436         val S = if needed "c_COMBS"
   437                 then (Output.debug (fn () => "Include combinator S"); cnf_helper_thms [comb_S])
   438                 else []
   439         val B'C' = if needed "c_COMBB_e" orelse needed "c_COMBC_e"
   440                    then (Output.debug (fn () => "Include combinator B' C'"); cnf_helper_thms [comb_B', comb_C'])
   441                    else []
   442         val S' = if needed "c_COMBS_e"
   443                  then (Output.debug (fn () => "Include combinator S'"); cnf_helper_thms [comb_S'])
   444                  else []
   445         val other = cnf_helper_thms [ext,fequal_imp_equal,equal_imp_fequal]
   446     in
   447         map #2 (make_axiom_clauses thy (other @ IK @ BC @ S @ B'C' @ S'))
   448     end;
   449 
   450 (*Find the minimal arity of each function mentioned in the term. Also, note which uses
   451   are not at top level, to see if hBOOL is needed.*)
   452 fun count_constants_term toplev t =
   453   let val (head, args) = strip_comb t
   454       val n = length args
   455       val _ = List.app (count_constants_term false) args
   456   in
   457       case head of
   458           CombConst (a,_,_) => (*predicate or function version of "equal"?*)
   459             let val a = if a="equal" andalso not toplev then "c_fequal" else a
   460             in
   461               const_min_arity := Symtab.map_default (a,n) (curry Int.min n) (!const_min_arity);
   462               if toplev then ()
   463               else const_needs_hBOOL := Symtab.update (a,true) (!const_needs_hBOOL)
   464             end
   465         | ts => ()
   466   end;
   467 
   468 (*A literal is a top-level term*)
   469 fun count_constants_lit (Literal (_,t)) = count_constants_term true t;
   470 
   471 fun count_constants_clause (Clause{literals,...}) = List.app count_constants_lit literals;
   472 
   473 fun display_arity (c,n) =
   474   Output.debug (fn () => "Constant: " ^ c ^ " arity:\t" ^ Int.toString n ^
   475                 (if needs_hBOOL c then " needs hBOOL" else ""));
   476 
   477 fun count_constants (conjectures, axclauses, helper_clauses) =
   478   if !minimize_applies then
   479     (const_min_arity := Symtab.empty;
   480      const_needs_hBOOL := Symtab.empty;
   481      List.app count_constants_clause conjectures;
   482      List.app count_constants_clause axclauses;
   483      List.app count_constants_clause helper_clauses;
   484      List.app display_arity (Symtab.dest (!const_min_arity)))
   485   else ();
   486 
   487 (* tptp format *)
   488 
   489 (* write TPTP format to a single file *)
   490 fun tptp_write_file thy isFO thms filename (ax_tuples,classrel_clauses,arity_clauses) user_lemmas =
   491     let val _ = Output.debug (fn () => ("Preparing to write the TPTP file " ^ filename))
   492         val _ = RC.dfg_format := false
   493         val conjectures = make_conjecture_clauses thy thms
   494         val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses thy ax_tuples)
   495         val helper_clauses = get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas)
   496         val _ = count_constants (conjectures, axclauses, helper_clauses);
   497         val (tptp_clss,tfree_litss) = ListPair.unzip (map clause2tptp conjectures)
   498         val tfree_clss = map RC.tptp_tfree_clause (foldl (op union_string) [] tfree_litss)
   499         val out = TextIO.openOut filename
   500     in
   501         List.app (curry TextIO.output out o #1 o clause2tptp) axclauses;
   502         RC.writeln_strs out tfree_clss;
   503         RC.writeln_strs out tptp_clss;
   504         List.app (curry TextIO.output out o RC.tptp_classrelClause) classrel_clauses;
   505         List.app (curry TextIO.output out o RC.tptp_arity_clause) arity_clauses;
   506         List.app (curry TextIO.output out o #1 o clause2tptp) helper_clauses;
   507         TextIO.closeOut out;
   508         clnames
   509     end;
   510 
   511 
   512 
   513 (* dfg format *)
   514 
   515 fun dfg_write_file thy isFO thms filename (ax_tuples,classrel_clauses,arity_clauses) user_lemmas =
   516     let val _ = Output.debug (fn () => ("Preparing to write the DFG file " ^ filename))
   517         val _ = RC.dfg_format := true
   518         val conjectures = make_conjecture_clauses thy thms
   519         val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses thy ax_tuples)
   520         val helper_clauses = get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas)
   521         val _ = count_constants (conjectures, axclauses, helper_clauses);
   522         val (dfg_clss, tfree_litss) = ListPair.unzip (map clause2dfg conjectures)
   523         and probname = Path.implode (Path.base (Path.explode filename))
   524         val axstrs = map (#1 o clause2dfg) axclauses
   525         val tfree_clss = map RC.dfg_tfree_clause (RC.union_all tfree_litss)
   526         val out = TextIO.openOut filename
   527         val helper_clauses_strs = map (#1 o clause2dfg) helper_clauses
   528         val (funcs,cl_preds) = decls_of_clauses (helper_clauses @ conjectures @ axclauses) arity_clauses
   529         and ty_preds = preds_of_clauses axclauses classrel_clauses arity_clauses
   530     in
   531         TextIO.output (out, RC.string_of_start probname);
   532         TextIO.output (out, RC.string_of_descrip probname);
   533         TextIO.output (out, RC.string_of_symbols
   534                               (RC.string_of_funcs funcs)
   535                               (RC.string_of_preds (cl_preds @ ty_preds)));
   536         TextIO.output (out, "list_of_clauses(axioms,cnf).\n");
   537         RC.writeln_strs out axstrs;
   538         List.app (curry TextIO.output out o RC.dfg_classrelClause) classrel_clauses;
   539         List.app (curry TextIO.output out o RC.dfg_arity_clause) arity_clauses;
   540         RC.writeln_strs out helper_clauses_strs;
   541         TextIO.output (out, "end_of_list.\n\nlist_of_clauses(conjectures,cnf).\n");
   542         RC.writeln_strs out tfree_clss;
   543         RC.writeln_strs out dfg_clss;
   544         TextIO.output (out, "end_of_list.\n\n");
   545         (*VarWeight=3 helps the HO problems, probably by counteracting the presence of hAPP*)
   546         TextIO.output (out, "list_of_settings(SPASS).\n{*\nset_flag(VarWeight,3).\n*}\nend_of_list.\n\n");
   547         TextIO.output (out, "end_problem.\n");
   548         TextIO.closeOut out;
   549         clnames
   550     end;
   551 
   552 end