238 level_of_type_sys type_sys = Const_Arg_Types) then |
238 level_of_type_sys type_sys = Const_Arg_Types) then |
239 No_Type_Args |
239 No_Type_Args |
240 else |
240 else |
241 general_type_arg_policy type_sys |
241 general_type_arg_policy type_sys |
242 |
242 |
243 fun atp_type_literals_for_types type_sys kind Ts = |
243 fun atp_type_literals_for_types format type_sys kind Ts = |
244 if level_of_type_sys type_sys = No_Types then |
244 if level_of_type_sys type_sys = No_Types orelse format = CNF_UEQ then |
245 [] |
245 [] |
246 else |
246 else |
247 Ts |> type_literals_for_types |
247 Ts |> type_literals_for_types |
248 |> filter (fn TyLitVar _ => kind <> Conjecture |
248 |> filter (fn TyLitVar _ => kind <> Conjecture |
249 | TyLitFree _ => kind = Conjecture) |
249 | TyLitFree _ => kind = Conjecture) |
878 end |
878 end |
879 | do_formula pos (AConn conn) = aconn_map pos do_formula conn |
879 | do_formula pos (AConn conn) = aconn_map pos do_formula conn |
880 | do_formula _ (AAtom tm) = AAtom (do_term tm) |
880 | do_formula _ (AAtom tm) = AAtom (do_term tm) |
881 in do_formula o SOME end |
881 in do_formula o SOME end |
882 |
882 |
883 fun bound_atomic_types type_sys Ts = |
883 fun bound_atomic_types format type_sys Ts = |
884 mk_ahorn (map (formula_from_fo_literal o fo_literal_from_type_literal) |
884 mk_ahorn (map (formula_from_fo_literal o fo_literal_from_type_literal) |
885 (atp_type_literals_for_types type_sys Axiom Ts)) |
885 (atp_type_literals_for_types format type_sys Axiom Ts)) |
886 |
886 |
887 fun formula_for_fact ctxt nonmono_Ts type_sys |
887 fun formula_for_fact ctxt format nonmono_Ts type_sys |
888 ({combformula, atomic_types, ...} : translated_formula) = |
888 ({combformula, atomic_types, ...} : translated_formula) = |
889 combformula |
889 combformula |
890 |> close_combformula_universally |
890 |> close_combformula_universally |
891 |> formula_from_combformula ctxt nonmono_Ts type_sys |
891 |> formula_from_combformula ctxt nonmono_Ts type_sys |
892 is_var_nonmonotonic_in_formula true |
892 is_var_nonmonotonic_in_formula true |
893 |> bound_atomic_types type_sys atomic_types |
893 |> bound_atomic_types format type_sys atomic_types |
894 |> close_formula_universally |
894 |> close_formula_universally |
895 |
895 |
896 (* Each fact is given a unique fact number to avoid name clashes (e.g., because |
896 (* Each fact is given a unique fact number to avoid name clashes (e.g., because |
897 of monomorphization). The TPTP explicitly forbids name clashes, and some of |
897 of monomorphization). The TPTP explicitly forbids name clashes, and some of |
898 the remote provers might care. *) |
898 the remote provers might care. *) |
899 fun formula_line_for_fact ctxt prefix nonmono_Ts type_sys |
899 fun formula_line_for_fact ctxt format prefix nonmono_Ts type_sys |
900 (j, formula as {name, locality, kind, ...}) = |
900 (j, formula as {name, locality, kind, ...}) = |
901 Formula (prefix ^ (if polymorphism_of_type_sys type_sys = Polymorphic then "" |
901 Formula (prefix ^ (if polymorphism_of_type_sys type_sys = Polymorphic then "" |
902 else string_of_int j ^ "_") ^ |
902 else string_of_int j ^ "_") ^ |
903 ascii_of name, |
903 ascii_of name, |
904 kind, formula_for_fact ctxt nonmono_Ts type_sys formula, NONE, |
904 kind, formula_for_fact ctxt format nonmono_Ts type_sys formula, NONE, |
905 case locality of |
905 case locality of |
906 Intro => intro_info |
906 Intro => intro_info |
907 | Elim => elim_info |
907 | Elim => elim_info |
908 | Simp => simp_info |
908 | Simp => simp_info |
909 | _ => NONE) |
909 | _ => NONE) |
937 formula_from_combformula ctxt nonmono_Ts type_sys |
937 formula_from_combformula ctxt nonmono_Ts type_sys |
938 is_var_nonmonotonic_in_formula false |
938 is_var_nonmonotonic_in_formula false |
939 (close_combformula_universally combformula) |
939 (close_combformula_universally combformula) |
940 |> close_formula_universally, NONE, NONE) |
940 |> close_formula_universally, NONE, NONE) |
941 |
941 |
942 fun free_type_literals type_sys ({atomic_types, ...} : translated_formula) = |
942 fun free_type_literals format type_sys |
943 atomic_types |> atp_type_literals_for_types type_sys Conjecture |
943 ({atomic_types, ...} : translated_formula) = |
|
944 atomic_types |> atp_type_literals_for_types format type_sys Conjecture |
944 |> map fo_literal_from_type_literal |
945 |> map fo_literal_from_type_literal |
945 |
946 |
946 fun formula_line_for_free_type j lit = |
947 fun formula_line_for_free_type j lit = |
947 Formula (tfree_prefix ^ string_of_int j, Hypothesis, |
948 Formula (tfree_prefix ^ string_of_int j, Hypothesis, |
948 formula_from_fo_literal lit, NONE, NONE) |
949 formula_from_fo_literal lit, NONE, NONE) |
949 fun formula_lines_for_free_types type_sys facts = |
950 fun formula_lines_for_free_types format type_sys facts = |
950 let |
951 let |
951 val litss = map (free_type_literals type_sys) facts |
952 val litss = map (free_type_literals format type_sys) facts |
952 val lits = fold (union (op =)) litss [] |
953 val lits = fold (union (op =)) litss [] |
953 in map2 formula_line_for_free_type (0 upto length lits - 1) lits end |
954 in map2 formula_line_for_free_type (0 upto length lits - 1) lits end |
954 |
955 |
955 (** Symbol declarations **) |
956 (** Symbol declarations **) |
956 |
957 |
1037 if pred_sym then `I tptp_tff_bool_type else res_ty) |
1038 if pred_sym then `I tptp_tff_bool_type else res_ty) |
1038 end |
1039 end |
1039 |
1040 |
1040 fun is_polymorphic_type T = fold_atyps (fn TVar _ => K true | _ => I) T false |
1041 fun is_polymorphic_type T = fold_atyps (fn TVar _ => K true | _ => I) T false |
1041 |
1042 |
1042 fun formula_line_for_pred_sym_decl ctxt conj_sym_kind nonmono_Ts type_sys n s j |
1043 fun formula_line_for_pred_sym_decl ctxt format conj_sym_kind nonmono_Ts type_sys |
1043 (s', T_args, T, _, ary, in_conj) = |
1044 n s j (s', T_args, T, _, ary, in_conj) = |
1044 let |
1045 let |
1045 val (kind, maybe_negate) = |
1046 val (kind, maybe_negate) = |
1046 if in_conj then (conj_sym_kind, conj_sym_kind = Conjecture ? mk_anot) |
1047 if in_conj then (conj_sym_kind, conj_sym_kind = Conjecture ? mk_anot) |
1047 else (Axiom, I) |
1048 else (Axiom, I) |
1048 val (arg_Ts, res_T) = chop_fun ary T |
1049 val (arg_Ts, res_T) = chop_fun ary T |
1061 |> type_pred_combterm ctxt nonmono_Ts type_sys res_T |
1062 |> type_pred_combterm ctxt nonmono_Ts type_sys res_T |
1062 |> AAtom |
1063 |> AAtom |
1063 |> mk_aquant AForall (bound_names ~~ bound_Ts) |
1064 |> mk_aquant AForall (bound_names ~~ bound_Ts) |
1064 |> formula_from_combformula ctxt nonmono_Ts type_sys |
1065 |> formula_from_combformula ctxt nonmono_Ts type_sys |
1065 (K (K (K (K true)))) true |
1066 (K (K (K (K true)))) true |
1066 |> n > 1 ? bound_atomic_types type_sys (atyps_of T) |
1067 |> n > 1 ? bound_atomic_types format type_sys (atyps_of T) |
1067 |> close_formula_universally |
1068 |> close_formula_universally |
1068 |> maybe_negate, |
1069 |> maybe_negate, |
1069 intro_info, NONE) |
1070 intro_info, NONE) |
1070 end |
1071 end |
1071 |
1072 |
1072 fun formula_lines_for_tag_sym_decl ctxt conj_sym_kind nonmono_Ts type_sys n s |
1073 fun formula_lines_for_tag_sym_decl ctxt format conj_sym_kind nonmono_Ts type_sys |
1073 (j, (s', T_args, T, pred_sym, ary, in_conj)) = |
1074 n s (j, (s', T_args, T, pred_sym, ary, in_conj)) = |
1074 let |
1075 let |
1075 val ident_base = |
1076 val ident_base = |
1076 sym_decl_prefix ^ s ^ (if n > 1 then "_" ^ string_of_int j else "") |
1077 sym_decl_prefix ^ s ^ (if n > 1 then "_" ^ string_of_int j else "") |
1077 val (kind, maybe_negate) = |
1078 val (kind, maybe_negate) = |
1078 if in_conj then (conj_sym_kind, conj_sym_kind = Conjecture ? mk_anot) |
1079 if in_conj then (conj_sym_kind, conj_sym_kind = Conjecture ? mk_anot) |
1084 fun const args = ATerm ((s, s'), map fo_term_from_typ T_args @ args) |
1085 fun const args = ATerm ((s, s'), map fo_term_from_typ T_args @ args) |
1085 val atomic_Ts = atyps_of T |
1086 val atomic_Ts = atyps_of T |
1086 fun eq tms = |
1087 fun eq tms = |
1087 (if pred_sym then AConn (AIff, map AAtom tms) |
1088 (if pred_sym then AConn (AIff, map AAtom tms) |
1088 else AAtom (ATerm (`I "equal", tms))) |
1089 else AAtom (ATerm (`I "equal", tms))) |
1089 |> bound_atomic_types type_sys atomic_Ts |
1090 |> bound_atomic_types format type_sys atomic_Ts |
1090 |> close_formula_universally |
1091 |> close_formula_universally |
1091 |> maybe_negate |
1092 |> maybe_negate |
1092 val should_encode = should_encode_type ctxt nonmono_Ts All_Types |
1093 val should_encode = should_encode_type ctxt nonmono_Ts All_Types |
1093 val tag_with = tag_with_type ctxt nonmono_Ts type_sys |
1094 val tag_with = tag_with_type ctxt nonmono_Ts type_sys |
1094 val add_formula_for_res = |
1095 val add_formula_for_res = |
1117 |> fold add_formula_for_arg (ary - 1 downto 0) |
1118 |> fold add_formula_for_arg (ary - 1 downto 0) |
1118 end |
1119 end |
1119 |
1120 |
1120 fun result_type_of_decl (_, _, T, _, ary, _) = chop_fun ary T |> snd |
1121 fun result_type_of_decl (_, _, T, _, ary, _) = chop_fun ary T |> snd |
1121 |
1122 |
1122 fun problem_lines_for_sym_decls ctxt conj_sym_kind nonmono_Ts type_sys |
1123 fun problem_lines_for_sym_decls ctxt format conj_sym_kind nonmono_Ts type_sys |
1123 (s, decls) = |
1124 (s, decls) = |
1124 case type_sys of |
1125 case type_sys of |
1125 Simple_Types level => map (decl_line_for_sym ctxt nonmono_Ts level s) decls |
1126 Simple_Types level => map (decl_line_for_sym ctxt nonmono_Ts level s) decls |
1126 | Preds _ => |
1127 | Preds _ => |
1127 let |
1128 let |
1141 decls |
1142 decls |
1142 |> filter (should_predicate_on_type ctxt nonmono_Ts type_sys (K true) |
1143 |> filter (should_predicate_on_type ctxt nonmono_Ts type_sys (K true) |
1143 o result_type_of_decl) |
1144 o result_type_of_decl) |
1144 in |
1145 in |
1145 (0 upto length decls - 1, decls) |
1146 (0 upto length decls - 1, decls) |
1146 |-> map2 (formula_line_for_pred_sym_decl ctxt conj_sym_kind nonmono_Ts |
1147 |-> map2 (formula_line_for_pred_sym_decl ctxt format conj_sym_kind |
1147 type_sys n s) |
1148 nonmono_Ts type_sys n s) |
1148 end |
1149 end |
1149 | Tags (_, _, heaviness) => |
1150 | Tags (_, _, heaviness) => |
1150 (case heaviness of |
1151 (case heaviness of |
1151 Heavy => [] |
1152 Heavy => [] |
1152 | Light => |
1153 | Light => |
1153 let val n = length decls in |
1154 let val n = length decls in |
1154 (0 upto n - 1 ~~ decls) |
1155 (0 upto n - 1 ~~ decls) |
1155 |> maps (formula_lines_for_tag_sym_decl ctxt conj_sym_kind nonmono_Ts |
1156 |> maps (formula_lines_for_tag_sym_decl ctxt format conj_sym_kind |
1156 type_sys n s) |
1157 nonmono_Ts type_sys n s) |
1157 end) |
1158 end) |
1158 |
1159 |
1159 fun problem_lines_for_sym_decl_table ctxt conj_sym_kind nonmono_Ts type_sys |
1160 fun problem_lines_for_sym_decl_table ctxt format conj_sym_kind nonmono_Ts |
1160 sym_decl_tab = |
1161 type_sys sym_decl_tab = |
1161 Symtab.fold_rev (append o problem_lines_for_sym_decls ctxt conj_sym_kind |
1162 Symtab.fold_rev |
1162 nonmono_Ts type_sys) |
1163 (append o problem_lines_for_sym_decls ctxt format conj_sym_kind nonmono_Ts |
1163 sym_decl_tab [] |
1164 type_sys) |
|
1165 sym_decl_tab [] |
1164 |
1166 |
1165 fun add_tff_types_in_formula (AQuant (_, xs, phi)) = |
1167 fun add_tff_types_in_formula (AQuant (_, xs, phi)) = |
1166 union (op =) (map_filter snd xs) #> add_tff_types_in_formula phi |
1168 union (op =) (map_filter snd xs) #> add_tff_types_in_formula phi |
1167 | add_tff_types_in_formula (AConn (_, phis)) = |
1169 | add_tff_types_in_formula (AConn (_, phis)) = |
1168 fold add_tff_types_in_formula phis |
1170 fold add_tff_types_in_formula phis |
1216 else |
1218 else |
1217 [TVar (("'a", 0), HOLogic.typeS)] |
1219 [TVar (("'a", 0), HOLogic.typeS)] |
1218 val sym_decl_lines = |
1220 val sym_decl_lines = |
1219 (conjs, helpers @ facts) |
1221 (conjs, helpers @ facts) |
1220 |> sym_decl_table_for_facts ctxt type_sys repaired_sym_tab |
1222 |> sym_decl_table_for_facts ctxt type_sys repaired_sym_tab |
1221 |> problem_lines_for_sym_decl_table ctxt conj_sym_kind lavish_nonmono_Ts |
1223 |> problem_lines_for_sym_decl_table ctxt format conj_sym_kind |
1222 type_sys |
1224 lavish_nonmono_Ts type_sys |
1223 val helper_lines = |
1225 val helper_lines = |
1224 map (formula_line_for_fact ctxt helper_prefix lavish_nonmono_Ts type_sys) |
1226 0 upto length helpers - 1 ~~ helpers |
1225 (0 upto length helpers - 1 ~~ helpers) |
1227 |> map (formula_line_for_fact ctxt format helper_prefix lavish_nonmono_Ts |
1226 |> (if should_add_ti_ti_helper type_sys then |
1228 type_sys) |
1227 cons (ti_ti_helper_fact ()) |
1229 |> (if should_add_ti_ti_helper type_sys then cons (ti_ti_helper_fact ()) |
1228 else |
1230 else I) |
1229 I) |
|
1230 (* Reordering these might confuse the proof reconstruction code or the SPASS |
1231 (* Reordering these might confuse the proof reconstruction code or the SPASS |
1231 Flotter hack. *) |
1232 Flotter hack. *) |
1232 val problem = |
1233 val problem = |
1233 [(sym_declsN, sym_decl_lines), |
1234 [(sym_declsN, sym_decl_lines), |
1234 (factsN, map (formula_line_for_fact ctxt fact_prefix nonmono_Ts type_sys) |
1235 (factsN, |
1235 (0 upto length facts - 1 ~~ facts)), |
1236 map (formula_line_for_fact ctxt format fact_prefix nonmono_Ts type_sys) |
|
1237 (0 upto length facts - 1 ~~ facts)), |
1236 (class_relsN, map formula_line_for_class_rel_clause class_rel_clauses), |
1238 (class_relsN, map formula_line_for_class_rel_clause class_rel_clauses), |
1237 (aritiesN, map formula_line_for_arity_clause arity_clauses), |
1239 (aritiesN, map formula_line_for_arity_clause arity_clauses), |
1238 (helpersN, helper_lines), |
1240 (helpersN, helper_lines), |
1239 (conjsN, map (formula_line_for_conjecture ctxt nonmono_Ts type_sys) |
1241 (conjsN, map (formula_line_for_conjecture ctxt nonmono_Ts type_sys) |
1240 conjs), |
1242 conjs), |
1241 (free_typesN, formula_lines_for_free_types type_sys (facts @ conjs))] |
1243 (free_typesN, |
|
1244 formula_lines_for_free_types format type_sys (facts @ conjs))] |
1242 val problem = |
1245 val problem = |
1243 problem |
1246 problem |
1244 |> (case type_sys of |
1247 |> (case type_sys of |
1245 Simple_Types _ => |
1248 Simple_Types _ => |
1246 cons (type_declsN, |
1249 cons (type_declsN, |