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