src/HOL/Tools/res_atp_setup.ML
author mengj
Mon Nov 28 07:15:13 2005 +0100 (2005-11-28)
changeset 18273 e15a825da262
parent 18197 082a2bd6f655
child 18357 c5030cdbf8da
permissions -rw-r--r--
Added in four control flags for HOL and FOL translations.
Changed functions that perform HOL/FOL translations, and write ATP input to files.
Removed some functions that are no longer needed.
mengj@17907
     1
(* ID: $Id$ 
mengj@17907
     2
   Author: Jia Meng, NICTA
mengj@17905
     3
mengj@17905
     4
*)
mengj@17905
     5
structure ResAtpSetup =
mengj@17905
     6
mengj@17905
     7
struct
mengj@17905
     8
mengj@17905
     9
val keep_atp_input = ref false;
mengj@17905
    10
val debug = ref true;
mengj@18273
    11
mengj@18273
    12
val fol_keep_types = ResClause.keep_types;
mengj@18273
    13
val hol_keep_types = ResHolClause.keep_types;
mengj@18273
    14
mengj@18273
    15
val include_combS = ResHolClause.include_combS;
mengj@18273
    16
val include_min_comb = ResHolClause.include_min_comb;
mengj@18273
    17
mengj@18273
    18
mengj@17905
    19
mengj@17905
    20
(*******************************************************)
mengj@17905
    21
(* set up the output paths                             *)
mengj@17905
    22
(*******************************************************)
mengj@17905
    23
mengj@18197
    24
fun typed_comb () = 
mengj@18197
    25
    if !ResHolClause.include_combS then 
mengj@18197
    26
	(ResAtp.helper_path "E_HOME" "additionals/comb_inclS"
mengj@18197
    27
	 handle _ => ResAtp.helper_path "VAMPIRE_HOME" "additionals/comb_inclS")
mengj@18197
    28
    else 
mengj@18197
    29
	(ResAtp.helper_path "E_HOME" "additionals/comb_noS"
mengj@18197
    30
	 handle _ => ResAtp.helper_path "VAMPIRE_HOME" "additionals/comb_noS");
mengj@18197
    31
mengj@18197
    32
fun untyped_comb () = 
mengj@18197
    33
    if !ResHolClause.include_combS then 
mengj@18197
    34
	(ResAtp.helper_path "E_HOME" "additionals/u_comb_inclS"
mengj@18197
    35
	 handle _ => ResAtp.helper_path "VAMPIRE_HOME" "additionals/u_comb_inclS")
mengj@18197
    36
    else
mengj@18197
    37
	(ResAtp.helper_path "E_HOME" "additionals/u_comb_noS"
mengj@18197
    38
	 handle _ => ResAtp.helper_path "VAMPIRE_HOME" "additionals/u_comb_noS");
mengj@18197
    39
mengj@18273
    40
mengj@18273
    41
fun typed_HOL_helper1 () = 
mengj@18273
    42
    ResAtp.helper_path "E_HOME" "additionals/helper1"
mengj@18273
    43
    handle _ => ResAtp.helper_path "VAMPIRE_HOME" "additionals/helper1";
mengj@18273
    44
mengj@18273
    45
mengj@18273
    46
fun untyped_HOL_helper1 () = 
mengj@18273
    47
    ResAtp.helper_path "E_HOME" "additionals/u_helper1"
mengj@18273
    48
    handle _ => ResAtp.helper_path "VAMPIRE_HOME" "additionals/u_helper1";
mengj@18273
    49
mengj@18273
    50
mengj@18273
    51
fun HOL_helper1 () =
mengj@18273
    52
    if !hol_keep_types then typed_HOL_helper1 () else untyped_HOL_helper1 ();
mengj@18273
    53
mengj@18273
    54
mengj@18273
    55
fun HOL_comb () =
mengj@18273
    56
    if !hol_keep_types then typed_comb() else untyped_comb();
mengj@18273
    57
mengj@18273
    58
mengj@17905
    59
val claset_file = File.tmp_path (Path.basic "claset");
mengj@17905
    60
val simpset_file = File.tmp_path (Path.basic "simp");
mengj@18086
    61
val local_lemma_file = File.tmp_path (Path.basic "locallemmas");
mengj@17905
    62
mengj@17905
    63
val prob_file = File.tmp_path (Path.basic "prob");
mengj@17905
    64
val hyps_file = File.tmp_path (Path.basic "hyps");
mengj@17905
    65
mengj@18001
    66
val types_sorts_file =  File.tmp_path (Path.basic "typsorts");
mengj@17905
    67
mengj@17905
    68
(*******************************************************)
mengj@17905
    69
(* operations on Isabelle theorems:                    *)
mengj@17905
    70
(* retrieving from ProofContext,                       *)
mengj@17905
    71
(* modifying local theorems,                           *)
mengj@17905
    72
(* CNF                                                 *)
mengj@17905
    73
(*******************************************************)
mengj@17905
    74
mengj@17905
    75
(* a special version of repeat_RS *)
mengj@18001
    76
fun repeat_someI_ex thm = ResAxioms.repeat_RS thm someI_ex;
mengj@17905
    77
mengj@17905
    78
val include_simpset = ref false;
mengj@17905
    79
val include_claset = ref false; 
mengj@17905
    80
mengj@17905
    81
val add_simpset = (fn () => include_simpset:=true);
mengj@17905
    82
val add_claset = (fn () => include_claset:=true);
mengj@17905
    83
val add_clasimp = (fn () => include_simpset:=true;include_claset:=true);
mengj@17905
    84
val rm_simpset = (fn () => include_simpset:=false);
mengj@17905
    85
val rm_claset = (fn () => include_claset:=false);
mengj@17905
    86
val rm_clasimp = (fn () => include_simpset:=false;include_claset:=false);
mengj@17905
    87
mengj@17905
    88
mengj@18273
    89
(******************************************************************)
mengj@18273
    90
(* detect whether a given problem (clauses) is FOL/HOL/HOLC/HOLCS *)
mengj@18273
    91
(******************************************************************)
mengj@18273
    92
mengj@18273
    93
datatype logic = FOL | HOL | HOLC | HOLCS;
mengj@18273
    94
mengj@18273
    95
fun string_of_logic FOL = "FOL"
mengj@18273
    96
  | string_of_logic HOL = "HOL"
mengj@18273
    97
  | string_of_logic HOLC = "HOLC"
mengj@18273
    98
  | string_of_logic HOLCS = "HOLCS";
mengj@18273
    99
mengj@18273
   100
(*HOLCS will not occur here*)
mengj@18273
   101
fun upgrade_lg HOLC _ = HOLC
mengj@18273
   102
  | upgrade_lg HOL HOLC = HOLC
mengj@18273
   103
  | upgrade_lg HOL _ = HOL
mengj@18273
   104
  | upgrade_lg FOL lg = lg; 
mengj@18273
   105
mengj@18273
   106
(* check types *)
mengj@18273
   107
fun has_bool (Type("bool",_)) = true
mengj@18273
   108
  | has_bool (Type(_, Ts)) = exists has_bool Ts
mengj@18273
   109
  | has_bool _ = false;
mengj@18273
   110
mengj@18273
   111
fun has_bool_arg tp = 
mengj@18273
   112
    let val (targs,tr) = strip_type tp
mengj@17905
   113
    in
mengj@18273
   114
	exists has_bool targs
mengj@17905
   115
    end;
mengj@17905
   116
mengj@18273
   117
fun is_fn_tp (Type("fun",_)) = true
mengj@18273
   118
  | is_fn_tp _ = false;
mengj@17905
   119
mengj@18273
   120
mengj@18273
   121
exception FN_LG of term;
mengj@18273
   122
mengj@18273
   123
fun fn_lg (t as Const(f,tp)) (lg,seen) = 
mengj@18273
   124
    if has_bool tp then (upgrade_lg HOL lg, t ins seen) else (lg, t ins seen) 
mengj@18273
   125
  | fn_lg (t as Free(f,tp)) (lg,seen) = 
mengj@18273
   126
    if has_bool tp then (upgrade_lg HOL lg, t ins seen) else (lg, t ins seen) 
mengj@18273
   127
  | fn_lg (t as Var(f,tp)) (lg,seen) =
mengj@18273
   128
    if is_fn_tp tp orelse has_bool tp then (upgrade_lg HOL lg,t ins seen)
mengj@18273
   129
    else (lg,t ins seen)
mengj@18273
   130
  | fn_lg (t as Abs(_,_,_)) (lg,seen) = (upgrade_lg HOLC lg,t ins seen)
mengj@18273
   131
  | fn_lg f _ = raise FN_LG(f); 
mengj@18273
   132
mengj@18273
   133
mengj@18273
   134
fun term_lg [] (lg,seen) = (lg,seen)
mengj@18273
   135
  | term_lg (tm::tms) (FOL,seen) =
mengj@18273
   136
    let val (f,args) = strip_comb tm
mengj@18273
   137
	val (lg',seen') = if f mem seen then (FOL,seen) 
mengj@18273
   138
			  else fn_lg f (FOL,seen)
mengj@18273
   139
mengj@18273
   140
	 in
mengj@18273
   141
	     term_lg (args@tms) (lg',seen')
mengj@18273
   142
    end
mengj@18273
   143
  | term_lg _ (lg,seen) = (lg,seen)
mengj@18273
   144
mengj@18273
   145
exception PRED_LG of term;
mengj@18273
   146
mengj@18273
   147
fun pred_lg (t as Const(P,tp)) (lg,seen)= 
mengj@18273
   148
    if has_bool_arg tp then (upgrade_lg HOL lg, t ins seen) else (lg,t ins seen) 
mengj@18273
   149
  | pred_lg (t as Free(P,tp)) (lg,seen) =
mengj@18273
   150
    if has_bool_arg tp then (upgrade_lg HOL lg, t ins seen) else (lg,t ins seen)
mengj@18273
   151
  | pred_lg (t as Var(_,_)) (lg,seen) = (upgrade_lg HOL lg, t ins seen)
mengj@18273
   152
  | pred_lg P _ = raise PRED_LG(P);
mengj@18273
   153
mengj@18273
   154
mengj@18273
   155
fun lit_lg (Const("Not",_) $ P) (lg,seen) = lit_lg P (lg,seen)
mengj@18273
   156
  | lit_lg P (lg,seen) =
mengj@18273
   157
    let val (pred,args) = strip_comb P
mengj@18273
   158
	val (lg',seen') = if pred mem seen then (lg,seen) 
mengj@18273
   159
			  else pred_lg pred (lg,seen)
mengj@17905
   160
    in
mengj@18273
   161
	term_lg args (lg',seen')
mengj@18273
   162
    end;
mengj@18273
   163
mengj@18273
   164
fun lits_lg [] (lg,seen) = (lg,seen)
mengj@18273
   165
  | lits_lg (lit::lits) (FOL,seen) =
mengj@18273
   166
    lits_lg lits (lit_lg lit (FOL,seen))
mengj@18273
   167
  | lits_lg lits (lg,seen) = (lg,seen);
mengj@18273
   168
mengj@18273
   169
mengj@18273
   170
fun logic_of_clause tm (lg,seen) =
mengj@18273
   171
    let val tm' = HOLogic.dest_Trueprop tm
mengj@18273
   172
	val disjs = HOLogic.dest_disj tm'
mengj@18273
   173
    in
mengj@18273
   174
	lits_lg disjs (lg,seen)
mengj@18273
   175
    end;
mengj@18273
   176
mengj@18273
   177
fun lits_lg [] (lg,seen) = (lg,seen)
mengj@18273
   178
  | lits_lg (lit::lits) (FOL,seen) =
mengj@18273
   179
    lits_lg lits (lit_lg lit (FOL,seen))
mengj@18273
   180
  | lits_lg lits (lg,seen) = (lg,seen);
mengj@18273
   181
mengj@18273
   182
mengj@18273
   183
fun logic_of_clause tm (lg,seen) =
mengj@18273
   184
    let val tm' = HOLogic.dest_Trueprop tm
mengj@18273
   185
	val disjs = HOLogic.dest_disj tm'
mengj@18273
   186
    in
mengj@18273
   187
	lits_lg disjs (lg,seen)
mengj@18273
   188
    end;
mengj@18273
   189
mengj@18273
   190
fun logic_of_clauses [] (lg,seen) = (lg,seen)
mengj@18273
   191
  | logic_of_clauses (cls::clss) (FOL,seen) =
mengj@18273
   192
    logic_of_clauses clss (logic_of_clause cls (FOL,seen))
mengj@18273
   193
  | logic_of_clauses (cls::clss) (lg,seen) = (lg,seen);
mengj@18273
   194
mengj@18273
   195
fun logic_of_nclauses [] (lg,seen) = (lg,seen)
mengj@18273
   196
  | logic_of_nclauses (cls::clss) (FOL,seen) =
mengj@18273
   197
    logic_of_nclauses clss (logic_of_clauses (snd cls) (FOL,seen))
mengj@18273
   198
  | logic_of_nclauses clss (lg,seen) = (lg,seen);
mengj@18273
   199
mengj@18273
   200
mengj@18273
   201
mengj@18273
   202
fun problem_logic (conj_cls,hyp_cls,userR,claR,simpR) =
mengj@18273
   203
    let val (lg1,seen1) = logic_of_clauses conj_cls (FOL,[])
mengj@18273
   204
	val (lg2,seen2) = logic_of_clauses hyp_cls (lg1,seen1)
mengj@18273
   205
	val (lg3,seen3) = logic_of_nclauses userR (lg2,seen2)
mengj@18273
   206
	val (lg4,seen4) = logic_of_nclauses claR (lg3,seen3)
mengj@18273
   207
	val (lg5,seen5) = logic_of_nclauses simpR (lg4,seen4)
mengj@18273
   208
    in
mengj@18273
   209
	lg5
mengj@18273
   210
    end;
mengj@17905
   211
mengj@17905
   212
mengj@17905
   213
mengj@17905
   214
(***************************************************************)
mengj@17905
   215
(* prover-specific output format:                              *)
mengj@17905
   216
(* TPTP                                                        *)
mengj@17905
   217
(***************************************************************)
mengj@17905
   218
mengj@18273
   219
(**** CNF rules and hypothesis ****)
mengj@18273
   220
fun cnf_rules_tms ctxt ths (include_claset,include_simpset) =
mengj@18273
   221
    let val local_claR = if include_claset then ResAxioms.claset_rules_of_ctxt ctxt else []
mengj@18273
   222
	val (local_claR_cls,err1) = ResAxioms.cnf_rules2 local_claR []
mengj@18273
   223
	val local_simpR = if include_simpset then ResAxioms.simpset_rules_of_ctxt ctxt else []
mengj@18273
   224
	val (local_simpR_cls,err2) = ResAxioms.cnf_rules2 local_simpR []
mengj@18273
   225
	val (user_ths_cls,err3) = ResAxioms.cnf_rules2 (map ResAxioms.pairname ths) []
mengj@18273
   226
	val errs = err3 @ err2 @ err1
mengj@18273
   227
    in
mengj@18273
   228
	(user_ths_cls,local_simpR_cls,local_claR_cls,errs)
mengj@18273
   229
    end;
mengj@17905
   230
mengj@18273
   231
fun cnf_hyps_thms ctxt = 
mengj@18273
   232
    let val ths = ProofContext.prems_of ctxt
mengj@18273
   233
	val prems = ResClause.union_all (map ResAxioms.cnf_axiom_aux ths)
mengj@18273
   234
    in
mengj@18273
   235
	prems
mengj@18273
   236
    end;
mengj@18273
   237
mengj@18273
   238
(**** clausification ****)
mengj@18273
   239
fun cls_axiom_fol _ _ [] = []
mengj@18273
   240
  | cls_axiom_fol name i (tm::tms) =
mengj@18273
   241
   (ResClause.make_axiom_clause tm (name,i)) :: (cls_axiom_fol name (i+1) tms);
mengj@18273
   242
mengj@18273
   243
fun cls_axiom_hol  _ _ [] = []
mengj@18273
   244
  | cls_axiom_hol name i (tm::tms) =
mengj@18273
   245
   (ResHolClause.make_axiom_clause tm (name,i)) :: (cls_axiom_hol name (i+1) tms);
mengj@17905
   246
mengj@17905
   247
mengj@18273
   248
fun filtered_tptp_axiom_fol name clss =
mengj@18273
   249
    (fst(ListPair.unzip (map ResClause.clause2tptp (filter (fn c => not (ResClause.isTaut c)) (cls_axiom_fol name 0 clss)))),[])
mengj@18273
   250
    handle _ => ([],[name]);
mengj@17905
   251
mengj@18273
   252
fun filtered_tptp_axiom_hol name clss =
mengj@18273
   253
    (fst(ListPair.unzip (map ResHolClause.clause2tptp (filter (fn c => not (ResHolClause.isTaut c)) (cls_axiom_hol name 0 clss)))),[])
mengj@18273
   254
    handle _ => ([],[name]);
mengj@18001
   255
mengj@18273
   256
fun tptp_axioms_g filt_ax_fn [] err = ([],err)
mengj@18273
   257
  | tptp_axioms_g filt_ax_fn ((name,clss)::nclss) err =
mengj@18273
   258
    let val (nclss1,err1) = tptp_axioms_g filt_ax_fn nclss err
mengj@18273
   259
	val (clsstrs,err_name_list) = filt_ax_fn name clss
mengj@18273
   260
    in
mengj@18273
   261
	case clsstrs of [] => (nclss1,err_name_list @ err1) 
mengj@18273
   262
		      | _ => (clsstrs::nclss1,err1)
mengj@18273
   263
    end;
mengj@18273
   264
		
mengj@18273
   265
fun tptp_axioms_fol rules = tptp_axioms_g filtered_tptp_axiom_fol rules [];
mengj@18273
   266
mengj@18273
   267
fun tptp_axioms_hol rules = tptp_axioms_g filtered_tptp_axiom_hol rules [];
mengj@18273
   268
mengj@18273
   269
mengj@18273
   270
fun atp_axioms_g tptp_ax_fn rules file =
mengj@18273
   271
    let val out = TextIO.openOut file
mengj@18273
   272
	val (clss,errs) = tptp_ax_fn rules
mengj@18273
   273
	val clss' = ResClause.union_all clss
mengj@18273
   274
    in
mengj@18273
   275
	ResAtp.writeln_strs out clss';
mengj@18273
   276
	TextIO.closeOut out;
mengj@18273
   277
	([file],errs)
mengj@18273
   278
    end;
mengj@18001
   279
mengj@18001
   280
mengj@18273
   281
fun atp_axioms_fol rules file = atp_axioms_g tptp_axioms_fol rules file;
mengj@18273
   282
mengj@18273
   283
fun atp_axioms_hol rules file = atp_axioms_g tptp_axioms_hol rules file;
mengj@18273
   284
mengj@18273
   285
mengj@18273
   286
fun filtered_tptp_conjectures_fol terms =
mengj@18273
   287
    let val clss = ResClause.make_conjecture_clauses terms
mengj@18273
   288
	val clss' = filter (fn c => not (ResClause.isTaut c)) clss
mengj@18273
   289
    in
mengj@18273
   290
	ListPair.unzip (map ResClause.clause2tptp clss')
mengj@18273
   291
    end;
mengj@18273
   292
mengj@18273
   293
fun filtered_tptp_conjectures_hol terms =
mengj@18273
   294
    let val clss = ResHolClause.make_conjecture_clauses terms
mengj@18273
   295
	val clss' = filter (fn c => not (ResHolClause.isTaut c)) clss
mengj@18273
   296
    in
mengj@18273
   297
	ListPair.unzip (map ResHolClause.clause2tptp clss')
mengj@18273
   298
    end;
mengj@18273
   299
mengj@18273
   300
fun atp_conjectures_h_g filt_conj_fn hyp_cls =
mengj@18273
   301
    let val (tptp_h_clss,tfree_litss) = filt_conj_fn hyp_cls
mengj@18273
   302
	val tfree_lits = ResClause.union_all tfree_litss
mengj@18273
   303
	val tfree_clss = map ResClause.tfree_clause tfree_lits 
mengj@18273
   304
	val hypsfile = File.platform_path hyps_file
mengj@18273
   305
        val out = TextIO.openOut(hypsfile)
mengj@18273
   306
    in
mengj@18273
   307
        ResAtp.writeln_strs out (tfree_clss @ tptp_h_clss);
mengj@18273
   308
        TextIO.closeOut out; warning hypsfile;
mengj@18273
   309
        ([hypsfile],tfree_lits)
mengj@18273
   310
    end;
mengj@18273
   311
mengj@18273
   312
fun atp_conjectures_h_fol hyp_cls = atp_conjectures_h_g filtered_tptp_conjectures_fol hyp_cls;
mengj@18273
   313
mengj@18273
   314
fun atp_conjectures_h_hol hyp_cls = atp_conjectures_h_g filtered_tptp_conjectures_hol hyp_cls;
mengj@18273
   315
mengj@18273
   316
fun atp_conjectures_c_g filt_conj_fn conj_cls n tfrees =
mengj@18273
   317
    let val (tptp_c_clss,tfree_litss) = filt_conj_fn conj_cls
mengj@17939
   318
	val tfree_clss = map ResClause.tfree_clause ((ResClause.union_all tfree_litss) \\ tfrees)
mengj@17905
   319
	val probfile = File.platform_path prob_file ^ "_" ^ string_of_int n
mengj@17905
   320
	val out = TextIO.openOut(probfile)		 	
mengj@17905
   321
    in
mengj@18273
   322
	ResAtp.writeln_strs out (tfree_clss @ tptp_c_clss);
mengj@17905
   323
	TextIO.closeOut out;
mengj@18273
   324
	warning probfile; 
mengj@18273
   325
	probfile 
mengj@17905
   326
    end;
mengj@17905
   327
mengj@18273
   328
fun atp_conjectures_c_fol conj_cls n tfrees = atp_conjectures_c_g filtered_tptp_conjectures_fol conj_cls n tfrees;
mengj@18001
   329
mengj@18273
   330
fun atp_conjectures_c_hol conj_cls n tfrees = atp_conjectures_c_g filtered_tptp_conjectures_hol conj_cls n tfrees;
mengj@18001
   331
mengj@18001
   332
mengj@18273
   333
fun atp_conjectures_g atp_conj_h_fn atp_conj_c_fn [] conj_cls n =
mengj@18273
   334
    let val probfile = atp_conj_c_fn conj_cls n []
mengj@17905
   335
    in
mengj@18273
   336
	[probfile]
mengj@18273
   337
    end
mengj@18273
   338
  | atp_conjectures_g atp_conj_h_fn atp_conj_c_fn hyp_cls conj_cls n =
mengj@18273
   339
    let val (hypsfile,tfree_lits) = atp_conj_h_fn hyp_cls
mengj@18273
   340
	val probfile = atp_conj_c_fn conj_cls n tfree_lits
mengj@18273
   341
    in
mengj@18273
   342
	(probfile::hypsfile)
mengj@17905
   343
    end;
mengj@17905
   344
mengj@18273
   345
fun atp_conjectures_fol hyp_cls conj_cls n = atp_conjectures_g atp_conjectures_h_fol atp_conjectures_c_fol hyp_cls conj_cls n;
mengj@18001
   346
mengj@18273
   347
fun atp_conjectures_hol hyp_cls conj_cls n = atp_conjectures_g atp_conjectures_h_hol atp_conjectures_c_hol hyp_cls conj_cls n;
mengj@18086
   348
mengj@17905
   349
mengj@18273
   350
(**** types and sorts ****)
mengj@18001
   351
fun tptp_types_sorts thy = 
mengj@18001
   352
    let val classrel_clauses = ResClause.classrel_clauses_thy thy
mengj@18001
   353
	val arity_clauses = ResClause.arity_clause_thy thy
mengj@18001
   354
	val classrel_cls = map ResClause.tptp_classrelClause classrel_clauses
mengj@18001
   355
	val arity_cls = map ResClause.tptp_arity_clause arity_clauses
mengj@18001
   356
	fun write_ts () =
mengj@18001
   357
	    let val tsfile = File.platform_path types_sorts_file
mengj@18001
   358
		val out = TextIO.openOut(tsfile)
mengj@18001
   359
	    in
mengj@18001
   360
		ResAtp.writeln_strs out (classrel_cls @ arity_cls);
mengj@18001
   361
		TextIO.closeOut out;
mengj@18001
   362
		[tsfile]
mengj@18001
   363
	    end
mengj@18001
   364
    in
mengj@18001
   365
	if (List.null arity_cls andalso List.null classrel_cls) then []
mengj@18001
   366
	else
mengj@18001
   367
	    write_ts ()
mengj@18001
   368
    end;
mengj@18001
   369
mengj@18001
   370
mengj@18273
   371
(******* write to files ******)
mengj@18001
   372
mengj@18273
   373
datatype mode = Auto | Fol | Hol;
mengj@18273
   374
mengj@18273
   375
fun write_out_g logic atp_ax_fn atp_conj_fn (claR,simpR,userR,hyp_cls,conj_cls,n,err) =
mengj@18273
   376
    let val (files1,err1) = if (null claR) then ([],[]) else (atp_ax_fn claR (File.platform_path claset_file))
mengj@18273
   377
	val (files2,err2) = if (null simpR) then ([],[]) else (atp_ax_fn simpR (File.platform_path simpset_file))
mengj@18273
   378
	val (files3,err3) = if (null userR) then ([],[]) else (atp_ax_fn userR (File.platform_path local_lemma_file))
mengj@18273
   379
	val files4 = atp_conj_fn hyp_cls conj_cls n
mengj@18273
   380
	val errs = err1 @ err2 @ err3 @ err
mengj@18273
   381
	val logic' = if !include_combS then HOLCS 
mengj@18273
   382
		     else 
mengj@18273
   383
			 if !include_min_comb then HOLC else logic
mengj@18273
   384
	val _ = warning ("Problems are " ^ (string_of_logic logic'))
mengj@18273
   385
	val _ = if (null errs) then () else warning ("Can't clausify thms: " ^ (ResClause.paren_pack errs))
mengj@18273
   386
	val helpers = case logic' of FOL => []
mengj@18273
   387
				   | HOL => [HOL_helper1 ()]
mengj@18273
   388
				   | _ => [HOL_helper1(),HOL_comb()] (*HOLC or HOLCS*)
mengj@18273
   389
    in
mengj@18273
   390
	include_min_comb:=false; (*reset to false*)
mengj@18273
   391
	include_combS:=false; (*reset to false*)
mengj@18273
   392
	(helpers,files4 @ files1 @ files2 @ files3)
mengj@18273
   393
    end;
mengj@18273
   394
mengj@18273
   395
fun write_out_fol (claR,simpR,userR,hyp_cls,conj_cls,n,err) = write_out_g FOL atp_axioms_fol atp_conjectures_fol (claR,simpR,userR,hyp_cls,conj_cls,n,err);
mengj@18273
   396
mengj@18273
   397
fun write_out_hol (claR,simpR,userR,hyp_cls,conj_cls,n,err) = write_out_g HOL atp_axioms_hol atp_conjectures_hol (claR,simpR,userR,hyp_cls,conj_cls,n,err);
mengj@18273
   398
mengj@18273
   399
fun write_out_fol_ts ctxt (claR,simpR,userR,hyp_cls,conj_cls,n,err) =  
mengj@18273
   400
    let val ts_file = if (!fol_keep_types) then tptp_types_sorts (ProofContext.theory_of ctxt) else []
mengj@18273
   401
	val (helpers,files) = write_out_fol (claR,simpR,userR,hyp_cls,conj_cls,n,err) 
mengj@18273
   402
    in
mengj@18273
   403
	(helpers,files@ts_file)
mengj@18273
   404
    end;
mengj@18273
   405
mengj@18273
   406
fun write_out_hol_ts ctxt (claR,simpR,userR,hyp_cls,conj_cls,n,err) =  
mengj@18273
   407
    let val ts_file = if (!hol_keep_types) then tptp_types_sorts (ProofContext.theory_of ctxt) else []
mengj@18273
   408
	val (helpers,files) = write_out_hol (claR,simpR,userR,hyp_cls,conj_cls,n,err)
mengj@18273
   409
    in
mengj@18273
   410
	(helpers,files@ts_file)
mengj@18273
   411
    end;
mengj@18273
   412
mengj@18273
   413
mengj@18273
   414
fun prep_atp_input mode ctxt conjectures user_thms n =
mengj@18273
   415
    let val conj_cls = map prop_of (make_clauses conjectures) 
mengj@18273
   416
	val (userR,simpR,claR,errs) = cnf_rules_tms ctxt user_thms (!include_claset,!include_simpset) 
mengj@18273
   417
	val hyp_cls = map prop_of (cnf_hyps_thms ctxt) 
mengj@18273
   418
	val logic = case mode of Auto => problem_logic (conj_cls,hyp_cls,userR,claR,simpR)
mengj@18273
   419
			       | Fol => FOL
mengj@18273
   420
			       | Hol => HOL
mengj@18273
   421
    in
mengj@18273
   422
	case logic of FOL => write_out_fol_ts ctxt (claR,simpR,userR,hyp_cls,conj_cls,n,errs)
mengj@18273
   423
		    | _ => write_out_hol_ts ctxt (claR,simpR,userR,hyp_cls,conj_cls,n,errs)
mengj@18273
   424
			   
mengj@18273
   425
    end;
mengj@17905
   426
mengj@17905
   427
mengj@17905
   428
(***************************************************************)
mengj@18086
   429
(* setup ATPs as Isabelle methods                              *)
mengj@17905
   430
(***************************************************************)
mengj@18273
   431
mengj@18273
   432
mengj@18273
   433
fun atp_meth' tac ths ctxt = 
mengj@18273
   434
    Method.SIMPLE_METHOD' HEADGOAL
mengj@18273
   435
    (tac ctxt ths);
mengj@18273
   436
mengj@18273
   437
fun atp_meth tac ths ctxt = 
mengj@18273
   438
    let val _ = ResClause.init (ProofContext.theory_of ctxt)
mengj@17905
   439
    in
mengj@18273
   440
	atp_meth' tac ths ctxt
mengj@18197
   441
    end;
mengj@17905
   442
mengj@17905
   443
mengj@18273
   444
fun atp_method tac = Method.thms_ctxt_args (atp_meth tac);
mengj@17905
   445
mengj@17905
   446
mengj@17905
   447
(*************Remove tmp files********************************)
mengj@17905
   448
fun rm_tmp_files1 [] = ()
mengj@17905
   449
  | rm_tmp_files1 (f::fs) =
mengj@17905
   450
    (OS.FileSys.remove f; rm_tmp_files1 fs);
mengj@17905
   451
mengj@17939
   452
fun cond_rm_tmp files = 
mengj@17939
   453
    if !keep_atp_input then warning "ATP input kept..." 
mengj@17939
   454
    else (warning "deleting ATP inputs..."; rm_tmp_files1 files);
mengj@17905
   455
mengj@17905
   456
mengj@17907
   457
end