author  blanchet 
Sun, 22 May 2011 14:51:42 +0200  
changeset 42944  9e620869a576 
parent 42943  62a14c80d194 
child 42951  40bf0173fbed 
permissions  rwrr 
40114  1 
(* Title: HOL/Tools/Sledgehammer/sledgehammer_atp_translate.ML 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

2 
Author: Fabian Immler, TU Muenchen 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

3 
Author: Makarius 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

4 
Author: Jasmin Blanchette, TU Muenchen 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

5 

39494
bf7dd4902321
rename "Metis_Clauses" to "Metis_Translate" for consistency with "Sledgehammer_Translate"
blanchet
parents:
39452
diff
changeset

6 
Translation of HOL to FOL for Sledgehammer. 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

7 
*) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

8 

40068  9 
signature SLEDGEHAMMER_ATP_TRANSLATE = 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

10 
sig 
42227
662b50b7126f
if "monomorphize" is enabled, mangle the type information in the names by default
blanchet
parents:
42180
diff
changeset

11 
type 'a fo_term = 'a ATP_Problem.fo_term 
42939  12 
type format = ATP_Problem.format 
42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

13 
type formula_kind = ATP_Problem.formula_kind 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

14 
type 'a problem = 'a ATP_Problem.problem 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

15 
type locality = Sledgehammer_Filter.locality 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

16 

23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

17 
datatype polymorphism = Polymorphic  Monomorphic  Mangled_Monomorphic 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

18 
datatype type_level = 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

19 
All_Types  Nonmonotonic_Types  Finite_Types  Const_Arg_Types  No_Types 
42837  20 
datatype type_heaviness = Heavy  Light 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

21 

23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

22 
datatype type_system = 
42722  23 
Simple_Types of type_level  
42837  24 
Preds of polymorphism * type_level * type_heaviness  
25 
Tags of polymorphism * type_level * type_heaviness 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

26 

40114  27 
type translated_formula 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

28 

42646
4781fcd53572
replaced some Unsynchronized.refs with Config.Ts
blanchet
parents:
42645
diff
changeset

29 
val readable_names : bool Config.T 
40204
da97d75e20e6
standardize on "fact" terminology (vs. "axiom" or "theorem") in Sledgehammer  but keep "Axiom" in the lowerlevel "ATP_Problem" module
blanchet
parents:
40145
diff
changeset

30 
val fact_prefix : string 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

31 
val conjecture_prefix : string 
42881
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

32 
val helper_prefix : string 
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

33 
val typed_helper_suffix : string 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

34 
val predicator_base : string 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

35 
val explicit_app_base : string 
42549
b9754f26c7bc
handle special constants correctly in Isar proof reconstruction code, especially type predicates
blanchet
parents:
42548
diff
changeset

36 
val type_pred_base : string 
42562  37 
val tff_type_prefix : string 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

38 
val type_sys_from_string : string > type_system 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

39 
val polymorphism_of_type_sys : type_system > polymorphism 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

40 
val level_of_type_sys : type_system > type_level 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

41 
val is_type_sys_virtually_sound : type_system > bool 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

42 
val is_type_sys_fairly_sound : type_system > bool 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

43 
val unmangled_const : string > string * string fo_term list 
41088  44 
val translate_atp_fact : 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

45 
Proof.context > bool > (string * locality) * thm 
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

46 
> translated_formula option * ((string * locality) * thm) 
40059
6ad9081665db
use consistent terminology in Sledgehammer: "prover = ATP or SMT solver or ..."
blanchet
parents:
39975
diff
changeset

47 
val prepare_atp_problem : 
42939  48 
Proof.context > format > formula_kind > formula_kind > type_system 
49 
> bool > term list > term 

41091
0afdf5cde874
implicitly call the minimizer for SMT solvers that don't return an unsat core
blanchet
parents:
41088
diff
changeset

50 
> (translated_formula option * ((string * 'a) * thm)) list 
42541
8938507b2054
move type declarations to the front, for TFFcompliance
blanchet
parents:
42540
diff
changeset

51 
> string problem * string Symtab.table * int * int 
42881
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

52 
* (string * 'a) list vector * int list * int Symtab.table 
41313
a96ac4d180b7
optionally supply constant weights to E  turned off by default until properly parameterized
blanchet
parents:
41211
diff
changeset

53 
val atp_problem_weights : string problem > (string * real) list 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

54 
end; 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

55 

41140
9c68004b8c9d
added Sledgehammer support for higherorder propositional reasoning
blanchet
parents:
41138
diff
changeset

56 
structure Sledgehammer_ATP_Translate : SLEDGEHAMMER_ATP_TRANSLATE = 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

57 
struct 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

58 

319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

59 
open ATP_Problem 
39494
bf7dd4902321
rename "Metis_Clauses" to "Metis_Translate" for consistency with "Sledgehammer_Translate"
blanchet
parents:
39452
diff
changeset

60 
open Metis_Translate 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

61 
open Sledgehammer_Util 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

62 
open Sledgehammer_Filter 
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

63 

879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

64 
(* experimental *) 
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

65 
val generate_useful_info = false 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

66 

42879  67 
fun useful_isabelle_info s = 
68 
if generate_useful_info then 

69 
SOME (ATerm ("[]", [ATerm ("isabelle_" ^ s, [])])) 

70 
else 

71 
NONE 

72 

73 
val intro_info = useful_isabelle_info "intro" 

74 
val elim_info = useful_isabelle_info "elim" 

75 
val simp_info = useful_isabelle_info "simp" 

76 

42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

77 
(* Readable names are often much shorter, especially if types are mangled in 
42589
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

78 
names. Also, the logic for generating legal SNARK sort names is only 
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

79 
implemented for readable names. Finally, readable names are, well, more 
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

80 
readable. For these reason, they are enabled by default. *) 
42646
4781fcd53572
replaced some Unsynchronized.refs with Config.Ts
blanchet
parents:
42645
diff
changeset

81 
val readable_names = 
4781fcd53572
replaced some Unsynchronized.refs with Config.Ts
blanchet
parents:
42645
diff
changeset

82 
Attrib.setup_config_bool @{binding sledgehammer_atp_readable_names} (K true) 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

83 

42543
f9d402d144d4
declare TFF types so that SNARK can be used with types
blanchet
parents:
42542
diff
changeset

84 
val type_decl_prefix = "type_" 
f9d402d144d4
declare TFF types so that SNARK can be used with types
blanchet
parents:
42542
diff
changeset

85 
val sym_decl_prefix = "sym_" 
40204
da97d75e20e6
standardize on "fact" terminology (vs. "axiom" or "theorem") in Sledgehammer  but keep "Axiom" in the lowerlevel "ATP_Problem" module
blanchet
parents:
40145
diff
changeset

86 
val fact_prefix = "fact_" 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

87 
val conjecture_prefix = "conj_" 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

88 
val helper_prefix = "help_" 
42543
f9d402d144d4
declare TFF types so that SNARK can be used with types
blanchet
parents:
42542
diff
changeset

89 
val class_rel_clause_prefix = "crel_"; 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

90 
val arity_clause_prefix = "arity_" 
39975
7c50d5ca5c04
avoid generating several formulas with the same name ("tfrees")
blanchet
parents:
39954
diff
changeset

91 
val tfree_prefix = "tfree_" 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

92 

42881
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

93 
val typed_helper_suffix = "_T" 
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

94 
val untyped_helper_suffix = "_U" 
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

95 

42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

96 
val predicator_base = "hBOOL" 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

97 
val explicit_app_base = "hAPP" 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

98 
val type_pred_base = "is" 
42562  99 
val tff_type_prefix = "ty_" 
42531
a462dbaa584f
added more rudimentary type support to Sledgehammer's ATP encoding
blanchet
parents:
42530
diff
changeset

100 

42562  101 
fun make_tff_type s = tff_type_prefix ^ ascii_of s 
42531
a462dbaa584f
added more rudimentary type support to Sledgehammer's ATP encoding
blanchet
parents:
42530
diff
changeset

102 

38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

103 
(* Freshness almost guaranteed! *) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

104 
val sledgehammer_weak_prefix = "Sledgehammer:" 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

105 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

106 
datatype polymorphism = Polymorphic  Monomorphic  Mangled_Monomorphic 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

107 
datatype type_level = 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

108 
All_Types  Nonmonotonic_Types  Finite_Types  Const_Arg_Types  No_Types 
42837  109 
datatype type_heaviness = Heavy  Light 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

110 

23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

111 
datatype type_system = 
42722  112 
Simple_Types of type_level  
42837  113 
Preds of polymorphism * type_level * type_heaviness  
114 
Tags of polymorphism * type_level * type_heaviness 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

115 

42689
e38590764c34
versions of ! and ? for the ASCIIchallenged Mirabelle
blanchet
parents:
42688
diff
changeset

116 
fun try_unsuffixes ss s = 
e38590764c34
versions of ! and ? for the ASCIIchallenged Mirabelle
blanchet
parents:
42688
diff
changeset

117 
fold (fn s' => fn NONE => try (unsuffix s') s  some => some) ss NONE 
e38590764c34
versions of ! and ? for the ASCIIchallenged Mirabelle
blanchet
parents:
42688
diff
changeset

118 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

119 
fun type_sys_from_string s = 
42722  120 
(case try (unprefix "poly_") s of 
121 
SOME s => (SOME Polymorphic, s) 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

122 
 NONE => 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

123 
case try (unprefix "mono_") s of 
42722  124 
SOME s => (SOME Monomorphic, s) 
125 
 NONE => 

126 
case try (unprefix "mangled_") s of 

127 
SOME s => (SOME Mangled_Monomorphic, s) 

128 
 NONE => (NONE, s)) 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

129 
> (fn s => 
42689
e38590764c34
versions of ! and ? for the ASCIIchallenged Mirabelle
blanchet
parents:
42688
diff
changeset

130 
(* "_query" and "_bang" are for the ASCIIchallenged Mirabelle. *) 
e38590764c34
versions of ! and ? for the ASCIIchallenged Mirabelle
blanchet
parents:
42688
diff
changeset

131 
case try_unsuffixes ["?", "_query"] s of 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

132 
SOME s => (Nonmonotonic_Types, s) 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

133 
 NONE => 
42689
e38590764c34
versions of ! and ? for the ASCIIchallenged Mirabelle
blanchet
parents:
42688
diff
changeset

134 
case try_unsuffixes ["!", "_bang"] s of 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

135 
SOME s => (Finite_Types, s) 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

136 
 NONE => (All_Types, s)) 
42828  137 
> apsnd (fn s => 
42837  138 
case try (unsuffix "_heavy") s of 
42854
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

139 
SOME s => (Heavy, s) 
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

140 
 NONE => (Light, s)) 
42837  141 
> (fn (poly, (level, (heaviness, core))) => 
142 
case (core, (poly, level, heaviness)) of 

42855  143 
("simple", (NONE, _, Light)) => Simple_Types level 
42854
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

144 
 ("preds", (SOME poly, _, _)) => Preds (poly, level, heaviness) 
42851
3bb63850488b
removed "poly_tags_light_bang" since highly unsound
blanchet
parents:
42837
diff
changeset

145 
 ("tags", (SOME Polymorphic, All_Types, _)) => 
42854
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

146 
Tags (Polymorphic, All_Types, heaviness) 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

147 
 ("tags", (SOME Polymorphic, _, _)) => 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

148 
(* The actual light encoding is very unsound. *) 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

149 
Tags (Polymorphic, level, Heavy) 
42854
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

150 
 ("tags", (SOME poly, _, _)) => Tags (poly, level, heaviness) 
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

151 
 ("args", (SOME poly, All_Types (* naja *), Light)) => 
42837  152 
Preds (poly, Const_Arg_Types, Light) 
42854
d99167ac4f8a
since we always default on the "_light" encoding (for good reasons, according to Judgment Day), get rid of that suffix
blanchet
parents:
42852
diff
changeset

153 
 ("erased", (NONE, All_Types (* naja *), Light)) => 
42837  154 
Preds (Polymorphic, No_Types, Light) 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

155 
 _ => raise Same.SAME) 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

156 
handle Same.SAME => error ("Unknown type system: " ^ quote s ^ ".") 
42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

157 

42722  158 
fun polymorphism_of_type_sys (Simple_Types _) = Mangled_Monomorphic 
42828  159 
 polymorphism_of_type_sys (Preds (poly, _, _)) = poly 
160 
 polymorphism_of_type_sys (Tags (poly, _, _)) = poly 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

161 

42722  162 
fun level_of_type_sys (Simple_Types level) = level 
42828  163 
 level_of_type_sys (Preds (_, level, _)) = level 
164 
 level_of_type_sys (Tags (_, level, _)) = level 

165 

42837  166 
fun heaviness_of_type_sys (Simple_Types _) = Heavy 
167 
 heaviness_of_type_sys (Preds (_, _, heaviness)) = heaviness 

168 
 heaviness_of_type_sys (Tags (_, _, heaviness)) = heaviness 

42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

169 

42687  170 
fun is_type_level_virtually_sound level = 
171 
level = All_Types orelse level = Nonmonotonic_Types 

42613
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

172 
val is_type_sys_virtually_sound = 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

173 
is_type_level_virtually_sound o level_of_type_sys 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

174 

23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

175 
fun is_type_level_fairly_sound level = 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

176 
is_type_level_virtually_sound level orelse level = Finite_Types 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

177 
val is_type_sys_fairly_sound = is_type_level_fairly_sound o level_of_type_sys 
23b13b1bd565
use strings to encode type systems in ATP module, to reduce the amount of outofplace information and also to make it easier to print the type system used
blanchet
parents:
42612
diff
changeset

178 

42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

179 
fun aconn_fold pos f (ANot, [phi]) = f (Option.map not pos) phi 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

180 
 aconn_fold pos f (AImplies, [phi1, phi2]) = 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

181 
f (Option.map not pos) phi1 #> f pos phi2 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

182 
 aconn_fold pos f (AAnd, phis) = fold (f pos) phis 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

183 
 aconn_fold pos f (AOr, phis) = fold (f pos) phis 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

184 
 aconn_fold _ f (_, phis) = fold (f NONE) phis 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

185 

85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

186 
fun aconn_map pos f (ANot, [phi]) = AConn (ANot, [f (Option.map not pos) phi]) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

187 
 aconn_map pos f (AImplies, [phi1, phi2]) = 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

188 
AConn (AImplies, [f (Option.map not pos) phi1, f pos phi2]) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

189 
 aconn_map pos f (AAnd, phis) = AConn (AAnd, map (f pos) phis) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

190 
 aconn_map pos f (AOr, phis) = AConn (AOr, map (f pos) phis) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

191 
 aconn_map _ f (c, phis) = AConn (c, map (f NONE) phis) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

192 

42680  193 
fun formula_fold pos f = 
42677
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

194 
let 
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

195 
fun aux pos (AQuant (_, _, phi)) = aux pos phi 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

196 
 aux pos (AConn conn) = aconn_fold pos aux conn 
42677
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

197 
 aux pos (AAtom tm) = f pos tm 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

198 
in aux pos end 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

199 

40114  200 
type translated_formula = 
38752
6628adcae4a7
consider "locality" when assigning weights to facts
blanchet
parents:
38748
diff
changeset

201 
{name: string, 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

202 
locality: locality, 
42525
7a506b0b644f
distinguish FOF and TFF (typed firstorder) in ATP abstract syntax tree
blanchet
parents:
42524
diff
changeset

203 
kind: formula_kind, 
42562  204 
combformula: (name, typ, combterm) formula, 
205 
atomic_types: typ list} 

38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

206 

42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

207 
fun update_combformula f ({name, locality, kind, combformula, atomic_types} 
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

208 
: translated_formula) = 
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

209 
{name = name, locality = locality, kind = kind, combformula = f combformula, 
42562  210 
atomic_types = atomic_types} : translated_formula 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

211 

42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

212 
fun fact_lift f ({combformula, ...} : translated_formula) = f combformula 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

213 

42677
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

214 

42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

215 
(* The Booleans indicate whether all type arguments should be kept. *) 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

216 
datatype type_arg_policy = 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

217 
Explicit_Type_Args of bool  
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

218 
Mangled_Type_Args of bool  
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

219 
No_Type_Args 
41136
30bedf58b177
implemented new type system encoding "overload_args", which is more lightweight than "const_args" (the unsound default) and hopefully almost as sound
blanchet
parents:
41134
diff
changeset

220 

42836  221 
fun should_drop_arg_type_args (Simple_Types _) = 
222 
false (* since TFF doesn't support overloading *) 

223 
 should_drop_arg_type_args type_sys = 

224 
level_of_type_sys type_sys = All_Types andalso 

42837  225 
heaviness_of_type_sys type_sys = Heavy 
42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

226 

42589
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

227 
fun general_type_arg_policy type_sys = 
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

228 
if level_of_type_sys type_sys = No_Types then 
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

229 
No_Type_Args 
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

230 
else if polymorphism_of_type_sys type_sys = Mangled_Monomorphic then 
42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

231 
Mangled_Type_Args (should_drop_arg_type_args type_sys) 
42589
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

232 
else 
42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

233 
Explicit_Type_Args (should_drop_arg_type_args type_sys) 
42563  234 

42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

235 
fun type_arg_policy _ @{const_name HOL.eq} = No_Type_Args 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

236 
 type_arg_policy type_sys _ = general_type_arg_policy type_sys 
42227
662b50b7126f
if "monomorphize" is enabled, mangle the type information in the names by default
blanchet
parents:
42180
diff
changeset

237 

42353
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

238 
fun atp_type_literals_for_types type_sys kind Ts = 
42589
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

239 
if level_of_type_sys type_sys = No_Types then 
42353
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

240 
[] 
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

241 
else 
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

242 
Ts > type_literals_for_types 
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

243 
> filter (fn TyLitVar _ => kind <> Conjecture 
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

244 
 TyLitFree _ => kind = Conjecture) 
41137
8b634031b2a5
implemented "no_types" encoding, which is too unsound to be useful but can come in handy for evaluations
blanchet
parents:
41136
diff
changeset

245 

42534
46e690db16b8
fake type declarations for fulltype args and mangled type encodings, so that type assumptions can be discharged
blanchet
parents:
42533
diff
changeset

246 
fun mk_aconns c phis = 
46e690db16b8
fake type declarations for fulltype args and mangled type encodings, so that type assumptions can be discharged
blanchet
parents:
42533
diff
changeset

247 
let val (phis', phi') = split_last phis in 
46e690db16b8
fake type declarations for fulltype args and mangled type encodings, so that type assumptions can be discharged
blanchet
parents:
42533
diff
changeset

248 
fold_rev (mk_aconn c) phis' phi' 
46e690db16b8
fake type declarations for fulltype args and mangled type encodings, so that type assumptions can be discharged
blanchet
parents:
42533
diff
changeset

249 
end 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

250 
fun mk_ahorn [] phi = phi 
42534
46e690db16b8
fake type declarations for fulltype args and mangled type encodings, so that type assumptions can be discharged
blanchet
parents:
42533
diff
changeset

251 
 mk_ahorn phis psi = AConn (AImplies, [mk_aconns AAnd phis, psi]) 
42522
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

252 
fun mk_aquant _ [] phi = phi 
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

253 
 mk_aquant q xs (phi as AQuant (q', xs', phi')) = 
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

254 
if q = q' then AQuant (q, xs @ xs', phi') else AQuant (q, xs, phi) 
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

255 
 mk_aquant q xs phi = AQuant (q, xs, phi) 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

256 

42522
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

257 
fun close_universally atom_vars phi = 
41145
a5ee3b8e5a90
improve partially tagged encoding by adding a helper fact that coalesces consecutive "ti" tags
blanchet
parents:
41140
diff
changeset

258 
let 
a5ee3b8e5a90
improve partially tagged encoding by adding a helper fact that coalesces consecutive "ti" tags
blanchet
parents:
41140
diff
changeset

259 
fun formula_vars bounds (AQuant (_, xs, phi)) = 
42526  260 
formula_vars (map fst xs @ bounds) phi 
41145
a5ee3b8e5a90
improve partially tagged encoding by adding a helper fact that coalesces consecutive "ti" tags
blanchet
parents:
41140
diff
changeset

261 
 formula_vars bounds (AConn (_, phis)) = fold (formula_vars bounds) phis 
42522
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

262 
 formula_vars bounds (AAtom tm) = 
42526  263 
union (op =) (atom_vars tm [] 
264 
> filter_out (member (op =) bounds o fst)) 

42522
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

265 
in mk_aquant AForall (formula_vars [] phi []) phi end 
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

266 

42531
a462dbaa584f
added more rudimentary type support to Sledgehammer's ATP encoding
blanchet
parents:
42530
diff
changeset

267 
fun combterm_vars (CombApp (tm1, tm2)) = fold combterm_vars [tm1, tm2] 
42522
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

268 
 combterm_vars (CombConst _) = I 
42574  269 
 combterm_vars (CombVar (name, T)) = insert (op =) (name, SOME T) 
42674  270 
fun close_combformula_universally phi = close_universally combterm_vars phi 
42522
413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

271 

413b56894f82
close ATP formulas universally earlier, so that we can add type predicates
blanchet
parents:
42521
diff
changeset

272 
fun term_vars (ATerm (name as (s, _), tms)) = 
42531
a462dbaa584f
added more rudimentary type support to Sledgehammer's ATP encoding
blanchet
parents:
42530
diff
changeset

273 
is_atp_variable s ? insert (op =) (name, NONE) 
42526  274 
#> fold term_vars tms 
42674  275 
fun close_formula_universally phi = close_universally term_vars phi 
41145
a5ee3b8e5a90
improve partially tagged encoding by adding a helper fact that coalesces consecutive "ti" tags
blanchet
parents:
41140
diff
changeset

276 

42562  277 
fun fo_term_from_typ (Type (s, Ts)) = 
278 
ATerm (`make_fixed_type_const s, map fo_term_from_typ Ts) 

279 
 fo_term_from_typ (TFree (s, _)) = 

280 
ATerm (`make_fixed_type_var s, []) 

281 
 fo_term_from_typ (TVar ((x as (s, _)), _)) = 

282 
ATerm ((make_schematic_type_var x, s), []) 

283 

284 
(* This shouldn't clash with anything else. *) 

42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

285 
val mangled_type_sep = "\000" 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

286 

42562  287 
fun generic_mangled_type_name f (ATerm (name, [])) = f name 
288 
 generic_mangled_type_name f (ATerm (name, tys)) = 

42761
8ea9c6fa8b53
fixed several bugs in Isar proof reconstruction, in particular w.r.t. mangled types and hAPP
blanchet
parents:
42755
diff
changeset

289 
f name ^ "(" ^ space_implode "," (map (generic_mangled_type_name f) tys) 
8ea9c6fa8b53
fixed several bugs in Isar proof reconstruction, in particular w.r.t. mangled types and hAPP
blanchet
parents:
42755
diff
changeset

290 
^ ")" 
42562  291 
val mangled_type_name = 
292 
fo_term_from_typ 

293 
#> (fn ty => (make_tff_type (generic_mangled_type_name fst ty), 

294 
generic_mangled_type_name snd ty)) 

42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

295 

42574  296 
fun generic_mangled_type_suffix f g Ts = 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

297 
fold_rev (curry (op ^) o g o prefix mangled_type_sep 
42574  298 
o generic_mangled_type_name f) Ts "" 
42562  299 
fun mangled_const_name T_args (s, s') = 
300 
let val ty_args = map fo_term_from_typ T_args in 

301 
(s ^ generic_mangled_type_suffix fst ascii_of ty_args, 

302 
s' ^ generic_mangled_type_suffix snd I ty_args) 

303 
end 

42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

304 

024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

305 
val parse_mangled_ident = 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

306 
Scan.many1 (not o member (op =) ["(", ")", ","]) >> implode 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

307 

024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

308 
fun parse_mangled_type x = 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

309 
(parse_mangled_ident 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

310 
 Scan.optional ($$ "("  Scan.optional parse_mangled_types []  $$ ")") 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

311 
[] >> ATerm) x 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

312 
and parse_mangled_types x = 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

313 
(parse_mangled_type ::: Scan.repeat ($$ ","  parse_mangled_type)) x 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

314 

024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

315 
fun unmangled_type s = 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

316 
s > suffix ")" > raw_explode 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

317 
> Scan.finite Symbol.stopper 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

318 
(Scan.error (!! (fn _ => raise Fail ("unrecognized mangled type " ^ 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

319 
quote s)) parse_mangled_type)) 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

320 
> fst 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

321 

42561
23ddc4e3d19c
have properly typeinstantiated helper facts (combinators and If)
blanchet
parents:
42560
diff
changeset

322 
val unmangled_const_name = space_explode mangled_type_sep #> hd 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

323 
fun unmangled_const s = 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

324 
let val ss = space_explode mangled_type_sep s in 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

325 
(hd ss, map unmangled_type (tl ss)) 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

326 
end 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

327 

42674  328 
fun introduce_proxies tm = 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

329 
let 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

330 
fun aux top_level (CombApp (tm1, tm2)) = 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

331 
CombApp (aux top_level tm1, aux false tm2) 
42574  332 
 aux top_level (CombConst (name as (s, s'), T, T_args)) = 
42570
77f94ac04f32
cleanup proxification/unproxification and make sure that "num_atp_type_args" is called on the proxy in the reconstruction code, since "c_fequal" has one type arg but the unproxified equal has 0
blanchet
parents:
42569
diff
changeset

333 
(case proxify_const s of 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

334 
SOME proxy_base => 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

335 
if top_level then 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

336 
(case s of 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

337 
"c_False" => (tptp_false, s') 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

338 
 "c_True" => (tptp_true, s') 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

339 
 _ => name, []) 
42569
5737947e4c77
make sure that fequal keeps its type arguments for mangled type systems
blanchet
parents:
42568
diff
changeset

340 
else 
42574  341 
(proxy_base >> prefix const_prefix, T_args) 
342 
 NONE => (name, T_args)) 

343 
> (fn (name, T_args) => CombConst (name, T, T_args)) 

42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

344 
 aux _ tm = tm 
42674  345 
in aux true tm end 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

346 

42562  347 
fun combformula_from_prop thy eq_as_iff = 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

348 
let 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

349 
fun do_term bs t atomic_types = 
41140
9c68004b8c9d
added Sledgehammer support for higherorder propositional reasoning
blanchet
parents:
41138
diff
changeset

350 
combterm_from_term thy bs (Envir.eta_contract t) 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

351 
>> (introduce_proxies #> AAtom) 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

352 
> union (op =) atomic_types 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

353 
fun do_quant bs q s T t' = 
38518
54727b44e277
handle bound name conflicts gracefully in FOF translation
blanchet
parents:
38496
diff
changeset

354 
let val s = Name.variant (map fst bs) s in 
54727b44e277
handle bound name conflicts gracefully in FOF translation
blanchet
parents:
38496
diff
changeset

355 
do_formula ((s, T) :: bs) t' 
42562  356 
#>> mk_aquant q [(`make_bound_var s, SOME T)] 
38518
54727b44e277
handle bound name conflicts gracefully in FOF translation
blanchet
parents:
38496
diff
changeset

357 
end 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

358 
and do_conn bs c t1 t2 = 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

359 
do_formula bs t1 ##>> do_formula bs t2 
42531
a462dbaa584f
added more rudimentary type support to Sledgehammer's ATP encoding
blanchet
parents:
42530
diff
changeset

360 
#>> uncurry (mk_aconn c) 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

361 
and do_formula bs t = 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

362 
case t of 
42531
a462dbaa584f
added more rudimentary type support to Sledgehammer's ATP encoding
blanchet
parents:
42530
diff
changeset

363 
@{const Not} $ t1 => do_formula bs t1 #>> mk_anot 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

364 
 Const (@{const_name All}, _) $ Abs (s, T, t') => 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

365 
do_quant bs AForall s T t' 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

366 
 Const (@{const_name Ex}, _) $ Abs (s, T, t') => 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

367 
do_quant bs AExists s T t' 
38795
848be46708dc
formerly unnamed infix conjunction and disjunction now named HOL.conj and HOL.disj
haftmann
parents:
38786
diff
changeset

368 
 @{const HOL.conj} $ t1 $ t2 => do_conn bs AAnd t1 t2 
848be46708dc
formerly unnamed infix conjunction and disjunction now named HOL.conj and HOL.disj
haftmann
parents:
38786
diff
changeset

369 
 @{const HOL.disj} $ t1 $ t2 => do_conn bs AOr t1 t2 
38786
e46e7a9cb622
formerly unnamed infix impliciation now named HOL.implies
haftmann
parents:
38752
diff
changeset

370 
 @{const HOL.implies} $ t1 $ t2 => do_conn bs AImplies t1 t2 
38864
4abe644fcea5
formerly unnamed infix equality now named HOL.eq
haftmann
parents:
38829
diff
changeset

371 
 Const (@{const_name HOL.eq}, Type (_, [@{typ bool}, _])) $ t1 $ t2 => 
41140
9c68004b8c9d
added Sledgehammer support for higherorder propositional reasoning
blanchet
parents:
41138
diff
changeset

372 
if eq_as_iff then do_conn bs AIff t1 t2 else do_term bs t 
9c68004b8c9d
added Sledgehammer support for higherorder propositional reasoning
blanchet
parents:
41138
diff
changeset

373 
 _ => do_term bs t 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

374 
in do_formula [] end 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

375 

42750
c8b1d9ee3758
ensure Set.member isn't introduced by Meson's preprocessing if it's supposed to be unfolded
blanchet
parents:
42747
diff
changeset

376 
fun presimplify_term ctxt = 
c8b1d9ee3758
ensure Set.member isn't introduced by Meson's preprocessing if it's supposed to be unfolded
blanchet
parents:
42747
diff
changeset

377 
Skip_Proof.make_thm (Proof_Context.theory_of ctxt) 
c8b1d9ee3758
ensure Set.member isn't introduced by Meson's preprocessing if it's supposed to be unfolded
blanchet
parents:
42747
diff
changeset

378 
#> Meson.presimplify ctxt 
c8b1d9ee3758
ensure Set.member isn't introduced by Meson's preprocessing if it's supposed to be unfolded
blanchet
parents:
42747
diff
changeset

379 
#> prop_of 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

380 

41491  381 
fun concealed_bound_name j = sledgehammer_weak_prefix ^ string_of_int j 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

382 
fun conceal_bounds Ts t = 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

383 
subst_bounds (map (Free o apfst concealed_bound_name) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

384 
(0 upto length Ts  1 ~~ Ts), t) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

385 
fun reveal_bounds Ts = 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

386 
subst_atomic (map (fn (j, T) => (Free (concealed_bound_name j, T), Bound j)) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

387 
(0 upto length Ts  1 ~~ Ts)) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

388 

42747
f132d13fcf75
use the same code for extensionalization in Metis and Sledgehammer and generalize that code so that it gracefully handles negations (e.g. negated conjecture), formulas of the form (%x. t) = u, etc.
blanchet
parents:
42742
diff
changeset

389 
fun extensionalize_term ctxt t = 
f132d13fcf75
use the same code for extensionalization in Metis and Sledgehammer and generalize that code so that it gracefully handles negations (e.g. negated conjecture), formulas of the form (%x. t) = u, etc.
blanchet
parents:
42742
diff
changeset

390 
let val thy = Proof_Context.theory_of ctxt in 
f132d13fcf75
use the same code for extensionalization in Metis and Sledgehammer and generalize that code so that it gracefully handles negations (e.g. negated conjecture), formulas of the form (%x. t) = u, etc.
blanchet
parents:
42742
diff
changeset

391 
t > cterm_of thy > Meson.extensionalize_conv ctxt 
f132d13fcf75
use the same code for extensionalization in Metis and Sledgehammer and generalize that code so that it gracefully handles negations (e.g. negated conjecture), formulas of the form (%x. t) = u, etc.
blanchet
parents:
42742
diff
changeset

392 
> prop_of > Logic.dest_equals > snd 
f132d13fcf75
use the same code for extensionalization in Metis and Sledgehammer and generalize that code so that it gracefully handles negations (e.g. negated conjecture), formulas of the form (%x. t) = u, etc.
blanchet
parents:
42742
diff
changeset

393 
end 
38608
01ed56c46259
beta eta contract the Sledgehammer conjecture (and also the axioms, although this might not be needed), just like Metis does (implicitly);
blanchet
parents:
38606
diff
changeset

394 

38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

395 
fun introduce_combinators_in_term ctxt kind t = 
42361  396 
let val thy = Proof_Context.theory_of ctxt in 
38491
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

397 
if Meson.is_fol_term thy t then 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

398 
t 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

399 
else 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

400 
let 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

401 
fun aux Ts t = 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

402 
case t of 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

403 
@{const Not} $ t1 => @{const Not} $ aux Ts t1 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

404 
 (t0 as Const (@{const_name All}, _)) $ Abs (s, T, t') => 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

405 
t0 $ Abs (s, T, aux (T :: Ts) t') 
38652
e063be321438
perform etaexpansion of quantifier bodies in Sledgehammer translation when needed + transform elim rules later;
blanchet
parents:
38618
diff
changeset

406 
 (t0 as Const (@{const_name All}, _)) $ t1 => 
e063be321438
perform etaexpansion of quantifier bodies in Sledgehammer translation when needed + transform elim rules later;
blanchet
parents:
38618
diff
changeset

407 
aux Ts (t0 $ eta_expand Ts t1 1) 
38491
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

408 
 (t0 as Const (@{const_name Ex}, _)) $ Abs (s, T, t') => 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

409 
t0 $ Abs (s, T, aux (T :: Ts) t') 
38652
e063be321438
perform etaexpansion of quantifier bodies in Sledgehammer translation when needed + transform elim rules later;
blanchet
parents:
38618
diff
changeset

410 
 (t0 as Const (@{const_name Ex}, _)) $ t1 => 
e063be321438
perform etaexpansion of quantifier bodies in Sledgehammer translation when needed + transform elim rules later;
blanchet
parents:
38618
diff
changeset

411 
aux Ts (t0 $ eta_expand Ts t1 1) 
38795
848be46708dc
formerly unnamed infix conjunction and disjunction now named HOL.conj and HOL.disj
haftmann
parents:
38786
diff
changeset

412 
 (t0 as @{const HOL.conj}) $ t1 $ t2 => t0 $ aux Ts t1 $ aux Ts t2 
848be46708dc
formerly unnamed infix conjunction and disjunction now named HOL.conj and HOL.disj
haftmann
parents:
38786
diff
changeset

413 
 (t0 as @{const HOL.disj}) $ t1 $ t2 => t0 $ aux Ts t1 $ aux Ts t2 
38786
e46e7a9cb622
formerly unnamed infix impliciation now named HOL.implies
haftmann
parents:
38752
diff
changeset

414 
 (t0 as @{const HOL.implies}) $ t1 $ t2 => t0 $ aux Ts t1 $ aux Ts t2 
38864
4abe644fcea5
formerly unnamed infix equality now named HOL.eq
haftmann
parents:
38829
diff
changeset

415 
 (t0 as Const (@{const_name HOL.eq}, Type (_, [@{typ bool}, _]))) 
38491
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

416 
$ t1 $ t2 => 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

417 
t0 $ aux Ts t1 $ aux Ts t2 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

418 
 _ => if not (exists_subterm (fn Abs _ => true  _ => false) t) then 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

419 
t 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

420 
else 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

421 
t > conceal_bounds Ts 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

422 
> Envir.eta_contract 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

423 
> cterm_of thy 
39890  424 
> Meson_Clausify.introduce_combinators_in_cterm 
38491
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

425 
> prop_of > Logic.dest_equals > snd 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

426 
> reveal_bounds Ts 
39370
f8292d3020db
use same hack as in "Async_Manager" to work around Proof General bug
blanchet
parents:
39005
diff
changeset

427 
val (t, ctxt') = Variable.import_terms true [t] ctxt >> the_single 
38491
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

428 
in t > aux [] > singleton (Variable.export_terms ctxt' ctxt) end 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

429 
handle THM _ => 
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

430 
(* A type variable of sort "{}" will make abstraction fail. *) 
38613
4ca2cae2653f
use "hypothesis" rather than "conjecture" for hypotheses in TPTP format;
blanchet
parents:
38610
diff
changeset

431 
if kind = Conjecture then HOLogic.false_const 
4ca2cae2653f
use "hypothesis" rather than "conjecture" for hypotheses in TPTP format;
blanchet
parents:
38610
diff
changeset

432 
else HOLogic.true_const 
38491
f7e51d981a9f
invoke Variable.export/import_term on the entire formula, to make sure that schematic variables don't get different indices in different subterms;
blanchet
parents:
38282
diff
changeset

433 
end 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

434 

319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

435 
(* Metis's use of "resolve_tac" freezes the schematic variables. We simulate the 
42353
7797efa897a1
correctly handle TFrees that occur in (local) facts  Metis did the right thing here but Sledgehammer was incorrectly generating spurious preconditions such as "dense_linorder(t_a)"
blanchet
parents:
42237
diff
changeset

436 
same in Sledgehammer to prevent the discovery of unreplayable proofs. *) 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

437 
fun freeze_term t = 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

438 
let 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

439 
fun aux (t $ u) = aux t $ aux u 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

440 
 aux (Abs (s, T, t)) = Abs (s, T, aux t) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

441 
 aux (Var ((s, i), T)) = 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

442 
Free (sledgehammer_weak_prefix ^ s ^ "_" ^ string_of_int i, T) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

443 
 aux t = t 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

444 
in t > exists_subterm is_Var t ? aux end 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

445 

40204
da97d75e20e6
standardize on "fact" terminology (vs. "axiom" or "theorem") in Sledgehammer  but keep "Axiom" in the lowerlevel "ATP_Problem" module
blanchet
parents:
40145
diff
changeset

446 
(* making fact and conjecture formulas *) 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

447 
fun make_formula ctxt eq_as_iff presimp name loc kind t = 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

448 
let 
42361  449 
val thy = Proof_Context.theory_of ctxt 
38608
01ed56c46259
beta eta contract the Sledgehammer conjecture (and also the axioms, although this might not be needed), just like Metis does (implicitly);
blanchet
parents:
38606
diff
changeset

450 
val t = t > Envir.beta_eta_contract 
42944
9e620869a576
improved Waldmeister support  even run it by default on unit equational goals
blanchet
parents:
42943
diff
changeset

451 
> transform_elim_prop 
41211
1e2e16bc0077
no need to do a superduper atomization if Metis fails afterwards anyway
blanchet
parents:
41199
diff
changeset

452 
> Object_Logic.atomize_term thy 
42563  453 
val need_trueprop = (fastype_of t = @{typ bool}) 
38652
e063be321438
perform etaexpansion of quantifier bodies in Sledgehammer translation when needed + transform elim rules later;
blanchet
parents:
38618
diff
changeset

454 
val t = t > need_trueprop ? HOLogic.mk_Trueprop 
42742
369dfc819056
unfold set constants in Sledgehammer/ATP as well if Metis does it too
blanchet
parents:
42734
diff
changeset

455 
> Raw_Simplifier.rewrite_term thy 
369dfc819056
unfold set constants in Sledgehammer/ATP as well if Metis does it too
blanchet
parents:
42734
diff
changeset

456 
(Meson.unfold_set_const_simps ctxt) [] 
42747
f132d13fcf75
use the same code for extensionalization in Metis and Sledgehammer and generalize that code so that it gracefully handles negations (e.g. negated conjecture), formulas of the form (%x. t) = u, etc.
blanchet
parents:
42742
diff
changeset

457 
> extensionalize_term ctxt 
42750
c8b1d9ee3758
ensure Set.member isn't introduced by Meson's preprocessing if it's supposed to be unfolded
blanchet
parents:
42747
diff
changeset

458 
> presimp ? presimplify_term ctxt 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

459 
> perhaps (try (HOLogic.dest_Trueprop)) 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

460 
> introduce_combinators_in_term ctxt kind 
38613
4ca2cae2653f
use "hypothesis" rather than "conjecture" for hypotheses in TPTP format;
blanchet
parents:
38610
diff
changeset

461 
> kind <> Axiom ? freeze_term 
42836  462 
val (combformula, atomic_types) = combformula_from_prop thy eq_as_iff t [] 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

463 
in 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

464 
{name = name, locality = loc, kind = kind, combformula = combformula, 
42562  465 
atomic_types = atomic_types} 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

466 
end 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

467 

42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

468 
fun make_fact ctxt keep_trivial eq_as_iff presimp ((name, loc), t) = 
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

469 
case (keep_trivial, make_formula ctxt eq_as_iff presimp name loc Axiom t) of 
41990
7f2793d51efc
add option to function to keep trivial ATP formulas, needed for some experiments
blanchet
parents:
41770
diff
changeset

470 
(false, {combformula = AAtom (CombConst (("c_True", _), _, _)), ...}) => 
7f2793d51efc
add option to function to keep trivial ATP formulas, needed for some experiments
blanchet
parents:
41770
diff
changeset

471 
NONE 
7f2793d51efc
add option to function to keep trivial ATP formulas, needed for some experiments
blanchet
parents:
41770
diff
changeset

472 
 (_, formula) => SOME formula 
42561
23ddc4e3d19c
have properly typeinstantiated helper facts (combinators and If)
blanchet
parents:
42560
diff
changeset

473 

42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

474 
fun make_conjecture ctxt prem_kind ts = 
38613
4ca2cae2653f
use "hypothesis" rather than "conjecture" for hypotheses in TPTP format;
blanchet
parents:
38610
diff
changeset

475 
let val last = length ts  1 in 
42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

476 
map2 (fn j => fn t => 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

477 
let 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

478 
val (kind, maybe_negate) = 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

479 
if j = last then 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

480 
(Conjecture, I) 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

481 
else 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

482 
(prem_kind, 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

483 
if prem_kind = Conjecture then update_combformula mk_anot 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

484 
else I) 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

485 
in 
42881
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

486 
make_formula ctxt true true (string_of_int j) General kind t 
42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

487 
> maybe_negate 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

488 
end) 
38613
4ca2cae2653f
use "hypothesis" rather than "conjecture" for hypotheses in TPTP format;
blanchet
parents:
38610
diff
changeset

489 
(0 upto last) ts 
4ca2cae2653f
use "hypothesis" rather than "conjecture" for hypotheses in TPTP format;
blanchet
parents:
38610
diff
changeset

490 
end 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

491 

42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

492 
(** Finite and infinite type inference **) 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

493 

42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

494 
fun deep_freeze_atyp (TVar (_, S)) = TFree ("v", S) 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

495 
 deep_freeze_atyp T = T 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

496 
val deep_freeze_type = map_atyps deep_freeze_atyp 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

497 

208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

498 
val type_instance = Sign.typ_instance o Proof_Context.theory_of 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

499 

42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

500 
(* Finite types such as "unit", "bool", "bool * bool", and "bool => bool" are 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

501 
dangerous because their "exhaust" properties can easily lead to unsound ATP 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

502 
proofs. On the other hand, all HOL infinite types can be given the same 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

503 
models in firstorder logic (via LÃ¶wenheimSkolem). *) 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

504 

42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

505 
fun should_encode_type ctxt (nonmono_Ts as _ :: _) _ T = 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

506 
exists (curry (type_instance ctxt) (deep_freeze_type T)) nonmono_Ts 
42836  507 
 should_encode_type _ _ All_Types _ = true 
42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

508 
 should_encode_type ctxt _ Finite_Types T = is_type_surely_finite ctxt T 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

509 
 should_encode_type _ _ _ _ = false 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

510 

42837  511 
fun should_predicate_on_type ctxt nonmono_Ts (Preds (_, level, heaviness)) 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

512 
should_predicate_on_var T = 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

513 
(heaviness = Heavy orelse should_predicate_on_var ()) andalso 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

514 
should_encode_type ctxt nonmono_Ts level T 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

515 
 should_predicate_on_type _ _ _ _ _ = false 
42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

516 

42836  517 
fun is_var_or_bound_var (CombConst ((s, _), _, _)) = 
518 
String.isPrefix bound_var_prefix s 

519 
 is_var_or_bound_var (CombVar _) = true 

520 
 is_var_or_bound_var _ = false 

521 

42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

522 
datatype tag_site = Top_Level  Eq_Arg  Elsewhere 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

523 

1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

524 
fun should_tag_with_type _ _ _ Top_Level _ _ = false 
42837  525 
 should_tag_with_type ctxt nonmono_Ts (Tags (_, level, heaviness)) site u T = 
526 
(case heaviness of 

527 
Heavy => should_encode_type ctxt nonmono_Ts level T 

528 
 Light => 

42836  529 
case (site, is_var_or_bound_var u) of 
530 
(Eq_Arg, true) => should_encode_type ctxt nonmono_Ts level T 

42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

531 
 _ => false) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

532 
 should_tag_with_type _ _ _ _ _ _ = false 
42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

533 

562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

534 
val homo_infinite_T = @{typ ind} (* any infinite type *) 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

535 

562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

536 
fun homogenized_type ctxt nonmono_Ts level T = 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

537 
if should_encode_type ctxt nonmono_Ts level T then T else homo_infinite_T 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

538 

42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

539 
(** "hBOOL" and "hAPP" **) 
41313
a96ac4d180b7
optionally supply constant weights to E  turned off by default until properly parameterized
blanchet
parents:
41211
diff
changeset

540 

42574  541 
type sym_info = 
42563  542 
{pred_sym : bool, min_ary : int, max_ary : int, typ : typ option} 
543 

42574  544 
fun add_combterm_syms_to_table explicit_apply = 
42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

545 
let 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

546 
fun aux top_level tm = 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

547 
let val (head, args) = strip_combterm_comb tm in 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

548 
(case head of 
42563  549 
CombConst ((s, _), T, _) => 
42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

550 
if String.isPrefix bound_var_prefix s then 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

551 
I 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

552 
else 
42563  553 
let val ary = length args in 
42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

554 
Symtab.map_default 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

555 
(s, {pred_sym = true, 
42563  556 
min_ary = if explicit_apply then 0 else ary, 
557 
max_ary = 0, typ = SOME T}) 

558 
(fn {pred_sym, min_ary, max_ary, typ} => 

42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

559 
{pred_sym = pred_sym andalso top_level, 
42563  560 
min_ary = Int.min (ary, min_ary), 
561 
max_ary = Int.max (ary, max_ary), 

562 
typ = if typ = SOME T then typ else NONE}) 

42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

563 
end 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

564 
 _ => I) 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

565 
#> fold (aux false) args 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

566 
end 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

567 
in aux true end 
42674  568 
fun add_fact_syms_to_table explicit_apply = 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

569 
fact_lift (formula_fold NONE (K (add_combterm_syms_to_table explicit_apply))) 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

570 

42675  571 
val default_sym_table_entries : (string * sym_info) list = 
42563  572 
[("equal", {pred_sym = true, min_ary = 2, max_ary = 2, typ = NONE}), 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

573 
(make_fixed_const predicator_base, 
42563  574 
{pred_sym = true, min_ary = 1, max_ary = 1, typ = NONE})] @ 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

575 
([tptp_false, tptp_true] 
42563  576 
> map (rpair {pred_sym = true, min_ary = 0, max_ary = 0, typ = NONE})) 
41140
9c68004b8c9d
added Sledgehammer support for higherorder propositional reasoning
blanchet
parents:
41138
diff
changeset

577 

42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

578 
fun sym_table_for_facts explicit_apply facts = 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

579 
Symtab.empty > fold Symtab.default default_sym_table_entries 
42574  580 
> fold (add_fact_syms_to_table explicit_apply) facts 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

581 

42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

582 
fun min_arity_of sym_tab s = 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

583 
case Symtab.lookup sym_tab s of 
42574  584 
SOME ({min_ary, ...} : sym_info) => min_ary 
42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

585 
 NONE => 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

586 
case strip_prefix_and_unascii const_prefix s of 
42547
b5eec0c99528
fixed arity of special constants if "explicit_apply" is set
blanchet
parents:
42546
diff
changeset

587 
SOME s => 
42570
77f94ac04f32
cleanup proxification/unproxification and make sure that "num_atp_type_args" is called on the proxy in the reconstruction code, since "c_fequal" has one type arg but the unproxified equal has 0
blanchet
parents:
42569
diff
changeset

588 
let val s = s > unmangled_const_name > invert_const in 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

589 
if s = predicator_base then 1 
42547
b5eec0c99528
fixed arity of special constants if "explicit_apply" is set
blanchet
parents:
42546
diff
changeset

590 
else if s = explicit_app_base then 2 
b5eec0c99528
fixed arity of special constants if "explicit_apply" is set
blanchet
parents:
42546
diff
changeset

591 
else if s = type_pred_base then 1 
42557
ae0deb39a254
fixed minarity computation when "explicit_apply" is specified
blanchet
parents:
42556
diff
changeset

592 
else 0 
42547
b5eec0c99528
fixed arity of special constants if "explicit_apply" is set
blanchet
parents:
42546
diff
changeset

593 
end 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

594 
 NONE => 0 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

595 

319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

596 
(* True if the constant ever appears outside of the toplevel position in 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

597 
literals, or if it appears with different arities (e.g., because of different 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

598 
type instantiations). If false, the constant always receives all of its 
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

599 
arguments and is used as a predicate. *) 
42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

600 
fun is_pred_sym sym_tab s = 
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

601 
case Symtab.lookup sym_tab s of 
42574  602 
SOME ({pred_sym, min_ary, max_ary, ...} : sym_info) => 
603 
pred_sym andalso min_ary = max_ary 

42558
3d9930cb6770
cleaned up "explicit_apply" so that it shares most of its code path with the default mode of operation
blanchet
parents:
42557
diff
changeset

604 
 NONE => false 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

605 

42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

606 
val predicator_combconst = 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

607 
CombConst (`make_fixed_const predicator_base, @{typ "bool => bool"}, []) 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

608 
fun predicator tm = CombApp (predicator_combconst, tm) 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

609 

42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

610 
fun introduce_predicators_in_combterm sym_tab tm = 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

611 
case strip_combterm_comb tm of 
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

612 
(CombConst ((s, _), _, _), _) => 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

613 
if is_pred_sym sym_tab s then tm else predicator tm 
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

614 
 _ => predicator tm 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

615 

42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

616 
fun list_app head args = fold (curry (CombApp o swap)) args head 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

617 

75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

618 
fun explicit_app arg head = 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

619 
let 
42562  620 
val head_T = combtyp_of head 
42693
3c2baf9b3c61
reverted 6efda6167e5d because unsound  Vampire found a counterexample
blanchet
parents:
42691
diff
changeset

621 
val (arg_T, res_T) = dest_funT head_T 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

622 
val explicit_app = 
42562  623 
CombConst (`make_fixed_const explicit_app_base, head_T > head_T, 
42693
3c2baf9b3c61
reverted 6efda6167e5d because unsound  Vampire found a counterexample
blanchet
parents:
42691
diff
changeset

624 
[arg_T, res_T]) 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

625 
in list_app explicit_app [head, arg] end 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

626 
fun list_explicit_app head args = fold explicit_app args head 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

627 

42565
93f58e6a6f3e
proper handling of partially applied proxy symbols
blanchet
parents:
42564
diff
changeset

628 
fun introduce_explicit_apps_in_combterm sym_tab = 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

629 
let 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

630 
fun aux tm = 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

631 
case strip_combterm_comb tm of 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

632 
(head as CombConst ((s, _), _, _), args) => 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

633 
args > map aux 
42557
ae0deb39a254
fixed minarity computation when "explicit_apply" is specified
blanchet
parents:
42556
diff
changeset

634 
> chop (min_arity_of sym_tab s) 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

635 
>> list_app head 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

636 
> list_explicit_app 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

637 
 (head, args) => list_explicit_app head (map aux args) 
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

638 
in aux end 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

639 

42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

640 
fun chop_fun 0 T = ([], T) 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

641 
 chop_fun n (Type (@{type_name fun}, [dom_T, ran_T])) = 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

642 
chop_fun (n  1) ran_T >> cons dom_T 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

643 
 chop_fun _ _ = raise Fail "unexpected nonfunction" 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

644 

42780
be6164bc9744
avoid "UnequalLengths" exception for special constant "fequal"  and optimize code in the common case where no type arguments are needed
blanchet
parents:
42778
diff
changeset

645 
fun filter_type_args _ _ _ [] = [] 
be6164bc9744
avoid "UnequalLengths" exception for special constant "fequal"  and optimize code in the common case where no type arguments are needed
blanchet
parents:
42778
diff
changeset

646 
 filter_type_args thy s arity T_args = 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

647 
let 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

648 
(* will throw "TYPE" for pseudoconstants *) 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

649 
val U = if s = explicit_app_base then 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

650 
@{typ "('a => 'b) => 'a => 'b"} > Logic.varifyT_global 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

651 
else 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

652 
s > Sign.the_const_type thy 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

653 
in 
42781  654 
case Term.add_tvarsT (U > chop_fun arity > snd) [] of 
655 
[] => [] 

656 
 res_U_vars => 

657 
let val U_args = (s, U) > Sign.const_typargs thy in 

658 
U_args ~~ T_args 

659 
> map_filter (fn (U, T) => 

660 
if member (op =) res_U_vars (dest_TVar U) then 

661 
SOME T 

662 
else 

663 
NONE) 

664 
end 

42780
be6164bc9744
avoid "UnequalLengths" exception for special constant "fequal"  and optimize code in the common case where no type arguments are needed
blanchet
parents:
42778
diff
changeset

665 
end 
be6164bc9744
avoid "UnequalLengths" exception for special constant "fequal"  and optimize code in the common case where no type arguments are needed
blanchet
parents:
42778
diff
changeset

666 
handle TYPE _ => T_args 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

667 

c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

668 
fun enforce_type_arg_policy_in_combterm ctxt nonmono_Ts type_sys = 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

669 
let 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

670 
val thy = Proof_Context.theory_of ctxt 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

671 
fun aux arity (CombApp (tm1, tm2)) = 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

672 
CombApp (aux (arity + 1) tm1, aux 0 tm2) 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

673 
 aux arity (CombConst (name as (s, _), T, T_args)) = 
42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

674 
let 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

675 
val level = level_of_type_sys type_sys 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

676 
val (T, T_args) = 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

677 
(* Aggressively merge most "hAPPs" if the type system is unsound 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

678 
anyway, by distinguishing overloads only on the homogenized 
42837  679 
result type. Don't do it for lightweight type systems, though, 
680 
since it leads to too many unsound proofs. *) 

42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

681 
if s = const_prefix ^ explicit_app_base andalso 
42726
70fc448a1815
avoid "Empty" exception by making sure that a certain optimization only is attempted when it makes sense
blanchet
parents:
42722
diff
changeset

682 
length T_args = 2 andalso 
42836  683 
not (is_type_sys_virtually_sound type_sys) andalso 
42837  684 
heaviness_of_type_sys type_sys = Heavy then 
42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

685 
T_args > map (homogenized_type ctxt nonmono_Ts level) 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

686 
> (fn Ts => let val T = hd Ts > nth Ts 1 in 
42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

687 
(T > T, tl Ts) 
42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

688 
end) 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

689 
else 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

690 
(T, T_args) 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

691 
in 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

692 
(case strip_prefix_and_unascii const_prefix s of 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

693 
NONE => (name, T_args) 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

694 
 SOME s'' => 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

695 
let 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

696 
val s'' = invert_const s'' 
42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

697 
fun filtered_T_args false = T_args 
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

698 
 filtered_T_args true = filter_type_args thy s'' arity T_args 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

699 
in 
42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

700 
case type_arg_policy type_sys s'' of 
42831
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

701 
Explicit_Type_Args drop_args => 
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

702 
(name, filtered_T_args drop_args) 
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

703 
 Mangled_Type_Args drop_args => 
c9b0968484fb
more work on "shallow" encoding + adjustments to other encodings
blanchet
parents:
42830
diff
changeset

704 
(mangled_const_name (filtered_T_args drop_args) name, []) 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

705 
 No_Type_Args => (name, []) 
42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

706 
end) 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

707 
> (fn (name, T_args) => CombConst (name, T, T_args)) 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

708 
end 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

709 
 aux _ tm = tm 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

710 
in aux 0 end 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

711 

42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

712 
fun repair_combterm ctxt nonmono_Ts type_sys sym_tab = 
42565
93f58e6a6f3e
proper handling of partially applied proxy symbols
blanchet
parents:
42564
diff
changeset

713 
introduce_explicit_apps_in_combterm sym_tab 
42568
7b9801a34836
no needless "fequal" proxies if "explicit_apply" is set + always have readable names
blanchet
parents:
42566
diff
changeset

714 
#> introduce_predicators_in_combterm sym_tab 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

715 
#> enforce_type_arg_policy_in_combterm ctxt nonmono_Ts type_sys 
42701
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

716 
fun repair_fact ctxt nonmono_Ts type_sys sym_tab = 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

717 
update_combformula (formula_map 
500e4a88675e
reintroduce unsoundnesses taken out in 4d29b4785f43 and 3c2baf9b3c61 but only for unsound type systems
blanchet
parents:
42700
diff
changeset

718 
(repair_combterm ctxt nonmono_Ts type_sys sym_tab)) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

719 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

720 
(** Helper facts **) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

721 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

722 
fun ti_ti_helper_fact () = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

723 
let 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

724 
fun var s = ATerm (`I s, []) 
42589
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

725 
fun tag tm = ATerm (`make_fixed_const type_tag_name, [var "X", tm]) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

726 
in 
42612  727 
Formula (helper_prefix ^ "ti_ti", Axiom, 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

728 
AAtom (ATerm (`I "equal", [tag (tag (var "Y")), tag (var "Y")])) 
42879  729 
> close_formula_universally, simp_info, NONE) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

730 
end 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

731 

42574  732 
fun helper_facts_for_sym ctxt type_sys (s, {typ, ...} : sym_info) = 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

733 
case strip_prefix_and_unascii const_prefix s of 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

734 
SOME mangled_s => 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

735 
let 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

736 
val thy = Proof_Context.theory_of ctxt 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

737 
val unmangled_s = mangled_s > unmangled_const_name 
42893
fd4babefe3f2
prevent unsound combinator proofs in partially typed polymorphic type systems
blanchet
parents:
42886
diff
changeset

738 
fun dub_and_inst c needs_fairly_sound (th, j) = 
42881
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

739 
((c ^ "_" ^ string_of_int j ^ 
42893
fd4babefe3f2
prevent unsound combinator proofs in partially typed polymorphic type systems
blanchet
parents:
42886
diff
changeset

740 
(if needs_fairly_sound then typed_helper_suffix 
42881
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

741 
else untyped_helper_suffix), 
dbdfe2d5b6ab
automatically use "metisFT" when typed helpers are necessary
blanchet
parents:
42879
diff
changeset

742 
General), 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

743 
let val t = th > prop_of in 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

744 
t > ((case general_type_arg_policy type_sys of 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

745 
Mangled_Type_Args _ => true 
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

746 
 _ => false) andalso 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

747 
not (null (Term.hidden_polymorphism t))) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

748 
? (case typ of 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

749 
SOME T => specialize_type thy (invert_const unmangled_s, T) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

750 
 NONE => I) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

751 
end) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

752 
fun make_facts eq_as_iff = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

753 
map_filter (make_fact ctxt false eq_as_iff false) 
42893
fd4babefe3f2
prevent unsound combinator proofs in partially typed polymorphic type systems
blanchet
parents:
42886
diff
changeset

754 
val fairly_sound = is_type_sys_fairly_sound type_sys 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

755 
in 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

756 
metis_helpers 
42894
ce269ee43800
further improvements to "poly_{preds,tags}_{bang,query}"  better solution to the combinator problem + make sure type assumptions can be discharged
blanchet
parents:
42893
diff
changeset

757 
> maps (fn (metis_s, (needs_fairly_sound, ths)) => 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

758 
if metis_s <> unmangled_s orelse 
42894
ce269ee43800
further improvements to "poly_{preds,tags}_{bang,query}"  better solution to the combinator problem + make sure type assumptions can be discharged
blanchet
parents:
42893
diff
changeset

759 
(needs_fairly_sound andalso not fairly_sound) then 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

760 
[] 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

761 
else 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

762 
ths ~~ (1 upto length ths) 
42893
fd4babefe3f2
prevent unsound combinator proofs in partially typed polymorphic type systems
blanchet
parents:
42886
diff
changeset

763 
> map (dub_and_inst mangled_s needs_fairly_sound) 
fd4babefe3f2
prevent unsound combinator proofs in partially typed polymorphic type systems
blanchet
parents:
42886
diff
changeset

764 
> make_facts (not needs_fairly_sound)) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

765 
end 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

766 
 NONE => [] 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

767 
fun helper_facts_for_sym_table ctxt type_sys sym_tab = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

768 
Symtab.fold_rev (append o helper_facts_for_sym ctxt type_sys) sym_tab [] 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

769 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

770 
fun translate_atp_fact ctxt keep_trivial = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

771 
`(make_fact ctxt keep_trivial true true o apsnd prop_of) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

772 

42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

773 
fun translate_formulas ctxt prem_kind type_sys hyp_ts concl_t rich_facts = 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

774 
let 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

775 
val thy = Proof_Context.theory_of ctxt 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

776 
val fact_ts = map (prop_of o snd o snd) rich_facts 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

777 
val (facts, fact_names) = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

778 
rich_facts 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

779 
> map_filter (fn (NONE, _) => NONE 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

780 
 (SOME fact, (name, _)) => SOME (fact, name)) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

781 
> ListPair.unzip 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

782 
(* Remove existing facts from the conjecture, as this can dramatically 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

783 
boost an ATP's performance (for some reason). *) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

784 
val hyp_ts = hyp_ts > filter_out (member (op aconv) fact_ts) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

785 
val goal_t = Logic.list_implies (hyp_ts, concl_t) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

786 
val all_ts = goal_t :: fact_ts 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

787 
val subs = tfree_classes_of_terms all_ts 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

788 
val supers = tvar_classes_of_terms all_ts 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

789 
val tycons = type_consts_of_terms thy all_ts 
42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

790 
val conjs = make_conjecture ctxt prem_kind (hyp_ts @ [concl_t]) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

791 
val (supers', arity_clauses) = 
42589
9f7c48463645
restructured type systems some more  the old naming schemes had "argshg diff less" and "tagshg diff less" as equivalent and didn't support a monomorphic version of "tags"
blanchet
parents:
42586
diff
changeset

792 
if level_of_type_sys type_sys = No_Types then ([], []) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

793 
else make_arity_clauses thy tycons supers 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

794 
val class_rel_clauses = make_class_rel_clauses thy subs supers' 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

795 
in 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

796 
(fact_names > map single, (conjs, facts, class_rel_clauses, arity_clauses)) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

797 
end 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

798 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

799 
fun fo_literal_from_type_literal (TyLitVar (class, name)) = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

800 
(true, ATerm (class, [ATerm (name, [])])) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

801 
 fo_literal_from_type_literal (TyLitFree (class, name)) = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

802 
(true, ATerm (class, [ATerm (name, [])])) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

803 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

804 
fun formula_from_fo_literal (pos, t) = AAtom t > not pos ? mk_anot 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

805 

42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

806 
fun type_pred_combterm ctxt nonmono_Ts type_sys T tm = 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

807 
CombApp (CombConst (`make_fixed_const type_pred_base, T > @{typ bool}, [T]) 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

808 
> enforce_type_arg_policy_in_combterm ctxt nonmono_Ts type_sys, 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

809 
tm) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

810 

42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

811 
fun var_occurs_positively_naked_in_term _ (SOME false) _ accum = accum 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

812 
 var_occurs_positively_naked_in_term name _ (ATerm ((s, _), tms)) accum = 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

813 
accum orelse (s = "equal" andalso member (op =) tms (ATerm (name, []))) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

814 
fun is_var_nonmonotonic_in_formula _ _ (SOME false) _ = false 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

815 
 is_var_nonmonotonic_in_formula pos phi _ name = 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

816 
formula_fold pos (var_occurs_positively_naked_in_term name) phi false 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

817 

42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

818 
fun tag_with_type ctxt nonmono_Ts type_sys T tm = 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

819 
CombConst (`make_fixed_const type_tag_name, T > T, [T]) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

820 
> enforce_type_arg_policy_in_combterm ctxt nonmono_Ts type_sys 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

821 
> term_from_combterm ctxt nonmono_Ts type_sys Top_Level 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

822 
> (fn ATerm (s, tms) => ATerm (s, tms @ [tm])) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

823 
and term_from_combterm ctxt nonmono_Ts type_sys site u = 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

824 
let 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

825 
val (head, args) = strip_combterm_comb u 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

826 
val (x as (s, _), T_args) = 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

827 
case head of 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

828 
CombConst (name, _, T_args) => (name, T_args) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

829 
 CombVar (name, _) => (name, []) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

830 
 CombApp _ => raise Fail "impossible \"CombApp\"" 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

831 
val arg_site = if site = Top_Level andalso s = "equal" then Eq_Arg 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

832 
else Elsewhere 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

833 
val t = ATerm (x, map fo_term_from_typ T_args @ 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

834 
map (term_from_combterm ctxt nonmono_Ts type_sys arg_site) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

835 
args) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

836 
val T = combtyp_of u 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

837 
in 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

838 
t > (if should_tag_with_type ctxt nonmono_Ts type_sys site u T then 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

839 
tag_with_type ctxt nonmono_Ts type_sys T 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

840 
else 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

841 
I) 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

842 
end 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

843 
and formula_from_combformula ctxt nonmono_Ts type_sys should_predicate_on_var = 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

844 
let 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

845 
val do_term = term_from_combterm ctxt nonmono_Ts type_sys Top_Level 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

846 
val do_bound_type = 
42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

847 
case type_sys of 
42722  848 
Simple_Types level => 
42682
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

849 
SOME o mangled_type_name o homogenized_type ctxt nonmono_Ts level 
562046fd8e0c
added type homogenization, whereby all (isomorphic) infinite types are mapped to the same type (to reduce the number of different predicates/TFFtypes)
blanchet
parents:
42680
diff
changeset

850 
 _ => K NONE 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

851 
fun do_out_of_bound_type pos phi universal (name, T) = 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

852 
if should_predicate_on_type ctxt nonmono_Ts type_sys 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

853 
(fn () => should_predicate_on_var pos phi universal name) T then 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

854 
CombVar (name, T) 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

855 
> type_pred_combterm ctxt nonmono_Ts type_sys T 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

856 
> do_term > AAtom > SOME 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

857 
else 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

858 
NONE 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

859 
fun do_formula pos (AQuant (q, xs, phi)) = 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

860 
let 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

861 
val phi = phi > do_formula pos 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

862 
val universal = Option.map (q = AExists ? not) pos 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

863 
in 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

864 
AQuant (q, xs > map (apsnd (fn NONE => NONE 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

865 
 SOME T => do_bound_type T)), 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

866 
(if q = AForall then mk_ahorn else fold_rev (mk_aconn AAnd)) 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

867 
(map_filter 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

868 
(fn (_, NONE) => NONE 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

869 
 (s, SOME T) => 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

870 
do_out_of_bound_type pos phi universal (s, T)) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

871 
xs) 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

872 
phi) 
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

873 
end 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

874 
 do_formula pos (AConn conn) = aconn_map pos do_formula conn 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

875 
 do_formula _ (AAtom tm) = AAtom (do_term tm) 
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

876 
in do_formula o SOME end 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

877 

42727
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

878 
fun bound_atomic_types type_sys Ts = 
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

879 
mk_ahorn (map (formula_from_fo_literal o fo_literal_from_type_literal) 
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

880 
(atp_type_literals_for_types type_sys Axiom Ts)) 
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

881 

42680  882 
fun formula_for_fact ctxt nonmono_Ts type_sys 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

883 
({combformula, atomic_types, ...} : translated_formula) = 
42727
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

884 
combformula 
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

885 
> close_combformula_universally 
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

886 
> formula_from_combformula ctxt nonmono_Ts type_sys 
42878
85ac4c12a4b7
slightly fewer type predicates introduced in the lightweight encoding, based on the observation that only universal positive equalities are dangerous
blanchet
parents:
42855
diff
changeset

887 
is_var_nonmonotonic_in_formula true 
42727
f365f5138771
ensure type class predicates are generated in symbol declarations (for "poly_preds" and similar)
blanchet
parents:
42726
diff
changeset

888 
> bound_atomic_types type_sys atomic_types 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

889 
> close_formula_universally 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

890 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

891 
(* Each fact is given a unique fact number to avoid name clashes (e.g., because 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

892 
of monomorphization). The TPTP explicitly forbids name clashes, and some of 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

893 
the remote provers might care. *) 
42680  894 
fun formula_line_for_fact ctxt prefix nonmono_Ts type_sys 
42640
879d2d6b05ce
generate tags for simps, intros, and elims in TPTP poblems on demand
blanchet
parents:
42613
diff
changeset

895 
(j, formula as {name, locality, kind, ...}) = 
42680  896 
Formula (prefix ^ (if polymorphism_of_type_sys type_sys = Polymorphic then "" 
897 
else string_of_int j ^ "_") ^ 

42647
59142dbfa3ba
no need to generate fact numbers for polymorphic type systems  this confuses the TPTP exporter
blanchet
parents:
42646
diff
changeset

898 
ascii_of name, 
42680  899 
kind, formula_for_fact ctxt nonmono_Ts type_sys formula, NONE, 
42879  900 
case locality of 
901 
Intro => intro_info 

902 
 Elim => elim_info 

903 
 Simp => simp_info 

904 
 _ => NONE) 

42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

905 

42939  906 
fun formula_line_for_class_rel_clause 
907 
(ClassRelClause {name, subclass, superclass, ...}) = 

42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

908 
let val ty_arg = ATerm (`I "T", []) in 
42577
78414ec6fa4e
made the format (TFF or FOF) of the TPTP problem a global argument of the problem again and have the ATPs report which formats they support
blanchet
parents:
42576
diff
changeset

909 
Formula (class_rel_clause_prefix ^ ascii_of name, Axiom, 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

910 
AConn (AImplies, [AAtom (ATerm (subclass, [ty_arg])), 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

911 
AAtom (ATerm (superclass, [ty_arg]))]) 
42879  912 
> close_formula_universally, intro_info, NONE) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

913 
end 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

914 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

915 
fun fo_literal_from_arity_literal (TConsLit (c, t, args)) = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

916 
(true, ATerm (c, [ATerm (t, map (fn arg => ATerm (arg, [])) args)])) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

917 
 fo_literal_from_arity_literal (TVarLit (c, sort)) = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

918 
(false, ATerm (c, [ATerm (sort, [])])) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

919 

42939  920 
fun formula_line_for_arity_clause 
921 
(ArityClause {name, prem_lits, concl_lits, ...}) = 

42577
78414ec6fa4e
made the format (TFF or FOF) of the TPTP problem a global argument of the problem again and have the ATPs report which formats they support
blanchet
parents:
42576
diff
changeset

922 
Formula (arity_clause_prefix ^ ascii_of name, Axiom, 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

923 
mk_ahorn (map (formula_from_fo_literal o apfst not 
42895  924 
o fo_literal_from_arity_literal) prem_lits) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

925 
(formula_from_fo_literal 
42895  926 
(fo_literal_from_arity_literal concl_lits)) 
42879  927 
> close_formula_universally, intro_info, NONE) 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

928 

42680  929 
fun formula_line_for_conjecture ctxt nonmono_Ts type_sys 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

930 
({name, kind, combformula, ...} : translated_formula) = 
42577
78414ec6fa4e
made the format (TFF or FOF) of the TPTP problem a global argument of the problem again and have the ATPs report which formats they support
blanchet
parents:
42576
diff
changeset

931 
Formula (conjecture_prefix ^ name, kind, 
42680  932 
formula_from_combformula ctxt nonmono_Ts type_sys 
42939  933 
is_var_nonmonotonic_in_formula false 
934 
(close_combformula_universally combformula) 

42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

935 
> close_formula_universally, NONE, NONE) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

936 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

937 
fun free_type_literals type_sys ({atomic_types, ...} : translated_formula) = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

938 
atomic_types > atp_type_literals_for_types type_sys Conjecture 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

939 
> map fo_literal_from_type_literal 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

940 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

941 
fun formula_line_for_free_type j lit = 
42577
78414ec6fa4e
made the format (TFF or FOF) of the TPTP problem a global argument of the problem again and have the ATPs report which formats they support
blanchet
parents:
42576
diff
changeset

942 
Formula (tfree_prefix ^ string_of_int j, Hypothesis, 
42573
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

943 
formula_from_fo_literal lit, NONE, NONE) 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

944 
fun formula_lines_for_free_types type_sys facts = 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

945 
let 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

946 
val litss = map (free_type_literals type_sys) facts 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

947 
val lits = fold (union (op =)) litss [] 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

948 
in map2 formula_line_for_free_type (0 upto length lits  1) lits end 
744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

949 

744215c3e90c
got rid of one "sym_table" in "prepare_atp_problem" now that proxies are always handled first, and tuned accordingly
blanchet
parents:
42572
diff
changeset

950 
(** Symbol declarations **) 
42544
75cb06eee990
reimplemented the hAPP introduction code so that it's done earlier, when the types are still available
blanchet
parents:
42543
diff
changeset

951 

42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

952 
fun insert_type ctxt get_T x xs = 
42677
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

953 
let val T = get_T x in 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

954 
if exists (curry (type_instance ctxt) T o get_T) xs then xs 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

955 
else x :: filter_out (curry (type_instance ctxt o swap) T o get_T) xs 
42677
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

956 
end 
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

957 

42574  958 
fun should_declare_sym type_sys pred_sym s = 
42542
024920b65ce2
perform constant mangling and/or removal of its type args in an earlier phase, so that the rest of the code doesn't need to worry about it
blanchet
parents:
42541
diff
changeset

959 
not (String.isPrefix bound_var_prefix s) andalso s <> "equal" andalso 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

960 
not (String.isPrefix tptp_special_prefix s) andalso 
42894
ce269ee43800
further improvements to "poly_{preds,tags}_{bang,query}"  better solution to the combinator problem + make sure type assumptions can be discharged
blanchet
parents:
42893
diff
changeset

961 
(case type_sys of 
ce269ee43800
further improvements to "poly_{preds,tags}_{bang,query}"  better solution to the combinator problem + make sure type assumptions can be discharged
blanchet
parents:
42893
diff
changeset

962 
Simple_Types _ => true 
ce269ee43800
further improvements to "poly_{preds,tags}_{bang,query}"  better solution to the combinator problem + make sure type assumptions can be discharged
blanchet
parents:
42893
diff
changeset

963 
 Tags (_, _, Light) => true 
ce269ee43800
further improvements to "poly_{preds,tags}_{bang,query}"  better solution to the combinator problem + make sure type assumptions can be discharged
blanchet
parents:
42893
diff
changeset

964 
 _ => not pred_sym) 
38282
319c59682c51
move Sledgehammer's HOL > FOL translation to separate file (sledgehammer_translate.ML)
blanchet
parents:
diff
changeset

965 

42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

966 
fun sym_decl_table_for_facts ctxt type_sys repaired_sym_tab (conjs, facts) = 
42574  967 
let 
42698
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

968 
fun add_combterm in_conj tm = 
42574  969 
let val (head, args) = strip_combterm_comb tm in 
970 
(case head of 

971 
CombConst ((s, s'), T, T_args) => 

972 
let val pred_sym = is_pred_sym repaired_sym_tab s in 

973 
if should_declare_sym type_sys pred_sym s then 

42576
a8a80a2a34be
merge symbol declarations that are typeinstances of each other  useful for type system "Args true" with monomorphization turned off
blanchet
parents:
42575
diff
changeset

974 
Symtab.map_default (s, []) 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

975 
(insert_type ctxt #3 (s', T_args, T, pred_sym, length args, 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

976 
in_conj)) 
42574  977 
else 
978 
I 

979 
end 

980 
 _ => I) 

42698
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

981 
#> fold (add_combterm in_conj) args 
42574  982 
end 
42698
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

983 
fun add_fact in_conj = 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

984 
fact_lift (formula_fold NONE (K (add_combterm in_conj))) 
42698
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

985 
in 
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

986 
Symtab.empty 
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

987 
> is_type_sys_fairly_sound type_sys 
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

988 
? (fold (add_fact true) conjs #> fold (add_fact false) facts) 
ffd1ae4ff5c6
help SOS by ensuring that typing information is marked as part of the conjecture + be more precise w.r.t. typedefs in monotonicity check
blanchet
parents:
42697
diff
changeset

989 
end 
42533  990 

42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

991 
(* These types witness that the type classes they belong to allow infinite 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

992 
models and hence that any types with these type classes is monotonic. *) 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

993 
val known_infinite_types = [@{typ nat}, @{typ int}, @{typ "nat => bool"}] 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

994 

42685  995 
(* This inference is described in section 2.3 of Claessen et al.'s "Sorting it 
996 
out with monotonicity" paper presented at CADE 2011. *) 

42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

997 
fun add_combterm_nonmonotonic_types _ _ (SOME false) _ = I 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

998 
 add_combterm_nonmonotonic_types ctxt level _ 
42680  999 
(CombApp (CombApp (CombConst (("equal", _), Type (_, [T, _]), _), tm1), 
1000 
tm2)) = 

1001 
(exists is_var_or_bound_var [tm1, tm2] andalso 

42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1002 
(case level of 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1003 
Nonmonotonic_Types => 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1004 
not (is_type_surely_infinite ctxt known_infinite_types T) 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1005 
 Finite_Types => is_type_surely_finite ctxt T 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1006 
 _ => true)) ? insert_type ctxt I (deep_freeze_type T) 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1007 
 add_combterm_nonmonotonic_types _ _ _ _ = I 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1008 
fun add_fact_nonmonotonic_types ctxt level ({kind, combformula, ...} 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1009 
: translated_formula) = 
42834
40f7691d0539
implemented thin versions of "preds" type systems + fixed various issues with type args
blanchet
parents:
42832
diff
changeset

1010 
formula_fold (SOME (kind <> Conjecture)) 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1011 
(add_combterm_nonmonotonic_types ctxt level) combformula 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1012 
fun nonmonotonic_types_for_facts ctxt type_sys facts = 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1013 
let val level = level_of_type_sys type_sys in 
42886
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1014 
if level = Nonmonotonic_Types orelse level = Finite_Types then 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1015 
[] > fold (add_fact_nonmonotonic_types ctxt level) facts 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1016 
(* We must add "bool" in case the helper "True_or_False" is added 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1017 
later. In addition, several places in the code rely on the list of 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1018 
nonmonotonic types not being empty. *) 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1019 
> insert_type ctxt I @{typ bool} 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1020 
else 
208ec29cc013
improved "poly_preds_{bang,query}" by picking up good witnesses for the possible infinity of common type classes and ensuring that "?'a::type" doesn't ruin everything
blanchet
parents:
42885
diff
changeset

1021 
[] 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1022 
end 
42677
25496cd3c199
monotonic type inference in ATP Sledgehammer problems  based on Claessen & al.'s CADE 2011 paper, Sect. 2.3.
blanchet
parents:
42675
diff
changeset

1023 

42754
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1024 
fun decl_line_for_sym ctxt nonmono_Ts level s (s', _, T, pred_sym, ary, _) = 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1025 
let 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1026 
val translate_type = 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1027 
mangled_type_name o homogenized_type ctxt nonmono_Ts level 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1028 
val (arg_tys, res_ty) = 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1029 
T > chop_fun ary >> map translate_type > translate_type 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1030 
in 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1031 
Decl (sym_decl_prefix ^ s, (s, s'), arg_tys, 
b9d7df8c51c8
make sure "simple_types_query" and "simple_types_bang" symbols are declared with the proper types
blanchet
parents:
42753
diff
changeset

1032 
if pred_sym then `I tptp_tff_bool_type else res_ty) 
42579
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1033 
end 
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1034 

42592
fa2cf11d6351
beware of polymorphic types in typed translation symbol declarations  match alphaequivalent types and, more importantly, prevent unsoundnesses by generating type constraints on the arguments of a polymorphic symbols (otherwise "hAPP" can be given any result type)
blanchet
parents:
42589
diff
changeset

1035 
fun is_polymorphic_type T = fold_atyps (fn TVar _ => K true  _ => I) T false 
fa2cf11d6351
beware of polymorphic types in typed translation symbol declarations  match alphaequivalent types and, more importantly, prevent unsoundnesses by generating type constraints on the arguments of a polymorphic symbols (otherwise "hAPP" can be given any result type)
blanchet
parents:
42589
diff
changeset

1036 

42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1037 
fun formula_line_for_pred_sym_decl ctxt conj_sym_kind nonmono_Ts type_sys n s j 
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1038 
(s', T_args, T, _, ary, in_conj) = 
42579
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1039 
let 
42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

1040 
val (kind, maybe_negate) = 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

1041 
if in_conj then (conj_sym_kind, conj_sym_kind = Conjecture ? mk_anot) 
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

1042 
else (Axiom, I) 
42753
c9552e617acc
drop some type arguments to constants in unsound type systems + remove a few type systems that make no sense from the circulation
blanchet
parents:
42750
diff
changeset

1043 
val (arg_Ts, res_T) = chop_fun ary T 
42579
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1044 
val bound_names = 
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1045 
1 upto length arg_Ts > map (`I o make_bound_var o string_of_int) 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
diff
changeset

1046 
val bounds = 
42579
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1047 
bound_names ~~ arg_Ts > map (fn (name, T) => CombConst (name, T, [])) 
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1048 
val bound_Ts = 
42592
fa2cf11d6351
beware of polymorphic types in typed translation symbol declarations  match alphaequivalent types and, more importantly, prevent unsoundnesses by generating type constraints on the arguments of a polymorphic symbols (otherwise "hAPP" can be given any result type)
blanchet
parents:
42589
diff
changeset

1049 
arg_Ts > map (fn T => if n > 1 orelse is_polymorphic_type T then SOME T 
fa2cf11d6351
beware of polymorphic types in typed translation symbol declarations  match alphaequivalent types and, more importantly, prevent unsoundnesses by generating type constraints on the arguments of a polymorphic symbols (otherwise "hAPP" can be given any result type)
blanchet
parents:
42589
diff
changeset

1050 
else NONE) 
42579
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1051 
in 
42612  1052 
Formula (sym_decl_prefix ^ s ^ 
42709
e7af132d48fe
allow each prover to specify its own formula kind for symbols occurring in the conjecture
blanchet
parents:
42701
diff
changeset

1053 
(if n > 1 then "_" ^ string_of_int j else ""), kind, 
42579
2552c09b1a72
implement the new ATP type system in Sledgehammer
blanchet
parents:
42577
diff
changeset

1054 
CombConst ((s, s'), T, T_args) 
42829
1558741f8a72
started implementing "shallow" type systems, based on ideas by Claessen et al.
blanchet
parents:
42828
