domain package registers induction rules
authorhuffman
Tue, 31 Mar 2009 15:57:10 -0700
changeset 30829d64a293f23ba
parent 30828 50c8f55cde7f
child 30830 521f7d801da1
child 30832 7c6e1843fda5
child 30834 1640e0625301
child 30837 3d4832d9f7e4
domain package registers induction rules
src/HOLCF/Tools/domain/domain_theorems.ML
     1.1 --- a/src/HOLCF/Tools/domain/domain_theorems.ML	Tue Mar 31 22:25:46 2009 +0200
     1.2 +++ b/src/HOLCF/Tools/domain/domain_theorems.ML	Tue Mar 31 15:57:10 2009 -0700
     1.3 @@ -610,7 +610,7 @@
     1.4      |> (snd o PureThy.add_thmss [
     1.5          ((Binding.name "iso_rews" , iso_rews  ), [Simplifier.simp_add]),
     1.6          ((Binding.name "exhaust"  , [exhaust] ), []),
     1.7 -        ((Binding.name "casedist" , [casedist]), [Induct.cases_type (Long_Name.base_name dname)]),
     1.8 +        ((Binding.name "casedist" , [casedist]), [Induct.cases_type dname]),
     1.9          ((Binding.name "when_rews", when_rews ), [Simplifier.simp_add]),
    1.10          ((Binding.name "compacts", con_compacts), [Simplifier.simp_add]),
    1.11          ((Binding.name "con_rews", con_rews), [Simplifier.simp_add]),
    1.12 @@ -999,6 +999,9 @@
    1.13      in pg [] goal (K tacs) end;
    1.14  end; (* local *)
    1.15  
    1.16 +val inducts = ProjectRule.projections (ProofContext.init thy) ind;
    1.17 +fun ind_rule (dname, rule) = ((Binding.empty, [rule]), [Induct.induct_type dname]);
    1.18 +
    1.19  in thy |> Sign.add_path comp_dnam
    1.20         |> (snd o (PureThy.add_thmss (map (Thm.no_attributes o apfst Binding.name) [
    1.21  		("take_rews"  , take_rews  ),
    1.22 @@ -1007,6 +1010,7 @@
    1.23  		("finite_ind", [finite_ind]),
    1.24  		("ind"       , [ind       ]),
    1.25  		("coind"     , [coind     ])])))
    1.26 +       |> (snd o (PureThy.add_thmss (map ind_rule (dnames ~~ inducts))))
    1.27         |> Sign.parent_path |> pair take_rews
    1.28  end; (* let *)
    1.29  end; (* local *)