polished interface of datatype package
authorhaftmann
Tue, 10 Jun 2008 15:31:04 +0200
changeset 27112 661a74bafeb7
parent 27111 c19be97e4553
child 27113 ac87245d8cab
polished interface of datatype package
src/HOL/Nominal/nominal_atoms.ML
src/HOL/Nominal/nominal_package.ML
src/HOL/Tools/inductive_realizer.ML
src/HOLCF/Tools/domain/domain_theorems.ML
--- a/src/HOL/Nominal/nominal_atoms.ML	Tue Jun 10 15:31:03 2008 +0200
+++ b/src/HOL/Nominal/nominal_atoms.ML	Tue Jun 10 15:31:04 2008 +0200
@@ -65,7 +65,7 @@
     val (_,thy1) = 
     fold_map (fn ak => fn thy => 
           let val dt = ([],ak,NoSyn,[(ak,[@{typ nat}],NoSyn)]) 
-              val ({inject,case_thms,...},thy1) = DatatypePackage.add_datatype_i true false [ak] [dt] thy
+              val ({inject,case_thms,...},thy1) = DatatypePackage.add_datatype true false [ak] [dt] thy
               val inject_flat = Library.flat inject
               val ak_type = Type (Sign.intern_type thy1 ak,[])
               val ak_sign = Sign.intern_const thy1 ak 
--- a/src/HOL/Nominal/nominal_package.ML	Tue Jun 10 15:31:03 2008 +0200
+++ b/src/HOL/Nominal/nominal_package.ML	Tue Jun 10 15:31:04 2008 +0200
@@ -248,7 +248,7 @@
     val full_new_type_names' = map (Sign.full_name thy) new_type_names';
 
     val ({induction, ...},thy1) =
-      DatatypePackage.add_datatype_i err flat_names new_type_names' dts'' thy;
+      DatatypePackage.add_datatype err flat_names new_type_names' dts'' thy;
 
     val SOME {descr, ...} = Symtab.lookup
       (DatatypePackage.get_datatypes thy1) (hd full_new_type_names');
--- a/src/HOL/Tools/inductive_realizer.ML	Tue Jun 10 15:31:03 2008 +0200
+++ b/src/HOL/Tools/inductive_realizer.ML	Tue Jun 10 15:31:04 2008 +0200
@@ -312,7 +312,7 @@
     val ((dummies, dt_info), thy2) =
       thy1
       |> add_dummies
-           (DatatypePackage.add_datatype_i false false (map #2 dts))
+           (DatatypePackage.add_datatype false false (map #2 dts))
            (map (pair false) dts) []
       ||> Extraction.add_typeof_eqns_i ty_eqs
       ||> Extraction.add_realizes_eqns_i rlz_eqs;
--- a/src/HOLCF/Tools/domain/domain_theorems.ML	Tue Jun 10 15:31:03 2008 +0200
+++ b/src/HOLCF/Tools/domain/domain_theorems.ML	Tue Jun 10 15:31:04 2008 +0200
@@ -647,7 +647,7 @@
       fun one_eq ((dn, args), _) = strict (dc_take dn $ %:"n");
       val goal = mk_trp (foldr1 mk_conj (map one_eq eqs));
       val tacs = [
-        DatatypePackage.induct_tac "n" 1,
+        DatatypePackage.induct_tac @{context} "n" 1,
         simp_tac iterate_Cprod_ss 1,
         asm_simp_tac (iterate_Cprod_ss addsimps copy_rews) 1];
     in pg copy_take_defs goal tacs end;
@@ -678,7 +678,7 @@
       fun eq_tacs ((dn, _), cons) = map con_tac cons;
       val tacs =
         simp_tac iterate_Cprod_ss 1 ::
-        DatatypePackage.induct_tac "n" 1 ::
+        DatatypePackage.induct_tac @{context} "n" 1 ::
         simp_tac (iterate_Cprod_ss addsimps copy_con_rews) 1 ::
         asm_full_simp_tac (HOLCF_ss addsimps simps) 1 ::
         TRY (safe_tac HOL_cs) ::
@@ -750,7 +750,7 @@
           val tacs1 = [
             quant_tac 1,
             simp_tac HOL_ss 1,
-            DatatypePackage.induct_tac "n" 1,
+            DatatypePackage.induct_tac @{context} "n" 1,
             simp_tac (take_ss addsimps prems) 1,
             TRY (safe_tac HOL_cs)];
           fun arg_tac arg =
@@ -845,7 +845,7 @@
               maps con_tacs cons;
             val tacs =
               rtac allI 1 ::
-              DatatypePackage.induct_tac "n" 1 ::
+              DatatypePackage.induct_tac @{context}  "n" 1 ::
               simp_tac take_ss 1 ::
               TRY (safe_tac (empty_cs addSEs [conjE] addSIs [conjI])) ::
               flat (mapn foo_tacs 1 (conss ~~ cases));
@@ -938,7 +938,7 @@
         REPEAT (CHANGED (asm_simp_tac take_ss 1))];
       val tacs = [
         rtac impI 1,
-        DatatypePackage.induct_tac "n" 1,
+        DatatypePackage.induct_tac @{context} "n" 1,
         simp_tac take_ss 1,
         safe_tac HOL_cs] @
         flat (mapn x_tacs 0 xs);