src/HOL/Tools/ATP/atp_problem_generate.ML
changeset 52004 6f3cab60621f
parent 52001 2fb33d73c366
child 52005 a86717e3859f
--- a/src/HOL/Tools/ATP/atp_problem_generate.ML	Wed May 15 18:09:20 2013 +0200
+++ b/src/HOL/Tools/ATP/atp_problem_generate.ML	Wed May 15 18:39:20 2013 +0200
@@ -59,6 +59,7 @@
   val class_decl_prefix : string
   val type_decl_prefix : string
   val sym_decl_prefix : string
+  val datatype_decl_prefix : string
   val class_memb_prefix : string
   val guards_sym_formula_prefix : string
   val tags_sym_formula_prefix : string
@@ -229,7 +230,8 @@
 val class_decl_prefix = "cl_"
 val type_decl_prefix = "ty_"
 val sym_decl_prefix = "sy_"
-val class_memb_prefix = "clmb_"
+val datatype_decl_prefix = "dt_"
+val class_memb_prefix = "cm_"
 val guards_sym_formula_prefix = "gsy_"
 val tags_sym_formula_prefix = "tsy_"
 val uncurried_alias_eq_prefix = "unc_"
@@ -2180,6 +2182,7 @@
 
 fun line_of_tcon_clause type_enc (name, prems, (cl, T)) =
   if polymorphism_of_type_enc type_enc = Type_Class_Polymorphic then
+    (* ### FIXME: is the list of type variables exhaustive? *)
     Class_Memb (class_memb_prefix ^ name,
                 map (fn (cls, T) =>
                         (T |> dest_TVar |> tvar_name, map (`make_class) cls))
@@ -2534,12 +2537,17 @@
     val decl_lines = maps (lines_of_sym_decls ctxt mono type_enc) syms
   in mono_lines @ decl_lines end
 
-fun decl_lines_of_datatypes (DFG Polymorphic) (type_enc as Native _) =
+fun datatypes_of_facts ctxt (DFG Polymorphic) (type_enc as Native _) facts =
     if is_type_enc_polymorphic type_enc then
-      [Datatype_Decl ("nat", [], AType (("naT", @{type_name nat}), []), [])] (*###*)
+      [(@{typ nat}, [@{term "0::nat"}, @{term Suc}], true)]
     else
       []
-  | decl_lines_of_datatypes _ _ = []
+  | datatypes_of_facts _ _ _ _ = []
+
+fun decl_line_of_datatype (_, [], _) = NONE
+  | decl_line_of_datatype (T as Type (s, _), ctrs, exhaust) =
+    SOME (Datatype_Decl (datatype_decl_prefix ^ ascii_of s, [],
+             AType (("naT", @{type_name nat}), []), [], exhaust)) (*###*)
 
 fun pair_append (xs1, xs2) (ys1, ys2) = (xs1 @ ys1, xs2 @ ys2)
 
@@ -2658,7 +2666,7 @@
     fun do_line (Class_Decl (_, _, cls)) = fold do_class cls
       | do_line (Type_Decl _) = I
       | do_line (Sym_Decl (_, _, ty)) = do_type ty
-      | do_line (Datatype_Decl (_, xs, ty, tms)) =
+      | do_line (Datatype_Decl (_, xs, ty, tms, _)) =
         fold do_bound_tvars xs #> do_type ty #> fold (do_term false) tms
       | do_line (Class_Memb (_, xs, ty, cl)) =
         fold do_bound_tvars xs #> do_type ty #> do_class cl
@@ -2754,14 +2762,15 @@
     val helpers =
       sym_tab |> helper_facts_of_sym_table ctxt format type_enc completish
               |> map (firstorderize true)
-    val mono_Ts =
-      helpers @ conjs @ facts |> monotonic_types_of_facts ctxt mono type_enc
+    val all_facts = helpers @ conjs @ facts
+    val mono_Ts = monotonic_types_of_facts ctxt mono type_enc all_facts
+    val datatypes = datatypes_of_facts ctxt format type_enc all_facts
     val class_decl_lines = decl_lines_of_classes type_enc classes
     val sym_decl_lines =
       (conjs, helpers @ facts, uncurried_alias_eq_tms)
       |> sym_decl_table_of_facts thy type_enc sym_tab
       |> lines_of_sym_decl_table ctxt mono type_enc mono_Ts
-    val datatype_decl_lines = decl_lines_of_datatypes format type_enc
+    val datatype_decl_lines = map_filter decl_line_of_datatype datatypes
     val decl_lines = class_decl_lines @ sym_decl_lines @ datatype_decl_lines
     val num_facts = length facts
     val fact_lines =