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