theory Examples

imports Complex_Main Lattice_Syntax

begin

section {* Fundamental Isabelle types

  and statically embedded logical entities *}

text {* Example 1 *}

lemmas latticify = inf_set_eq [symmetric] sup_set_eq [symmetric]

  (*bot_set_eq [symmetric]*) (*top_set_eq [symmetric]*) 

  Inf_set_eq [symmetric] Sup_set_eq [symmetric]

ML {*

val latticify = MetaSimplifier.rewrite_rule

  (map Simpdata.mk_eq @{thms latticify})

*}

thm Diff_Int_distrib

ML {*

latticify @{thm Diff_Int_distrib}

*}

text {* Example 2 *}

ML {*

  @{term "{ f x | x. P x }"}

*}

ML {*

  case @{term "{ f x | x. P x }"}

   of _ $ Abs (_, _, t) => t

*}

section {* Passing states and accumulating results *}

text {* Example 3 *}

(*local_setup {* fn lthy =>

  snd (LocalTheory.define Thm.definitionK

    ((@{binding identity}, NoSyn),

      ((@{binding indentity_def}, []), @{term "\<lambda>x\<Colon>'a. x"})) lthy)

*}*)

print_theorems

text {* Example 4 *}

local_setup {* fn lthy => lthy

  |> LocalTheory.define Thm.definitionK

      ((@{binding identity}, NoSyn),

        ((@{binding indentity_def}, []), @{term "\<lambda>x\<Colon>'a. x"}))

  |> snd

*}

text {* Example 5 *}

term "(default, distinct)"

setup {* fn thy =>

  thy

  |> fold (Sign.add_const_constraint)

      [(@{const_name default}, SOME @{typ "'a::type"}),

        (@{const_name distinct}, SOME @{typ "'a::eq list \<Rightarrow> bool"})]

*}

term "(default, distinct)"

text {* Example 6 *}

local_setup {* fn lthy =>

let

  fun mk_dummy_var v = ("", TFree (v, @{sort type}));

  fun mk_proj i = ("proj_" ^ string_of_int i,

    list_abs (map mk_dummy_var (Name.invent_list [] "'a" i), Bound 0));

  val projs = map mk_proj (1 upto 9);

in

  lthy

  |> fold_map (fn (bname, t) => LocalTheory.define Thm.definitionK

       ((Binding.name bname, NoSyn),

         ((Binding.name (Thm.def_name bname), []), t)))

           projs

  |-> (fn defs => LocalTheory.note Thm.lemmaK

       ((@{binding proj_fold}, []), map (symmetric o snd o snd) defs))

  |> snd

end

*}

print_theorems

section {* Managing generic data *}

ML {*

signature REWRITER =

sig

  val add: thm -> Context.generic -> Context.generic

  val del: thm -> Context.generic -> Context.generic

  val rewrite: Context.generic -> conv

end

*}

ML {*

structure Rewriter : REWRITER =

struct

structure Data = GenericDataFun(

struct

  type T = thm list;

  val empty = [];

  fun merge _ = Thm.merge_thms;

  val extend = I;

end);

fun add thm = Data.map (Thm.add_thm thm);

fun del thm = Data.map (Thm.del_thm thm);

fun rewrite ctxt = MetaSimplifier.rewrite false

  (map Simpdata.mk_eq (Data.get ctxt));

end

*}

attribute_setup rewrite =

  {* Scan.succeed (Thm.declaration_attribute Rewriter.add) *}

  ""

method_setup rewrite =

  {* Scan.state >> (fn ctxt =>

    K (SIMPLE_METHOD' (CONVERSION (Rewriter.rewrite ctxt)))) *}

  ""

lemma "A \<sqinter> B = \<Inter>{A, B}"

proof -

  note latticify [symmetric, rewrite]

  show ?thesis

  apply rewrite

  apply simp

  done

qed

lemma "A \<inter> B = A \<sqinter> B"

proof -

  show ?thesis

  apply rewrite

  oops

section {* For your amusement *}

end