progtut/Essential.thy~
changeset 26 1cde7bf45858
parent 25 a5f5b9336007
--- a/progtut/Essential.thy~	Sat Sep 13 10:07:14 2014 +0800
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,213 +0,0 @@
-theory Essential
-imports FirstStep
-begin
-
-ML {*
-fun pretty_helper aux env =
-  env |> Vartab.dest
-      |> map aux
-      |> map (fn (s1, s2) => Pretty.block [s1, Pretty.str " := ", s2])
-      |> Pretty.enum "," "[" "]"
-      |> pwriteln
-
-fun pretty_tyenv ctxt tyenv =
-let
-  fun get_typs (v, (s, T)) = (TVar (v, s), T)
-  val print = pairself (pretty_typ ctxt)
-in
-  pretty_helper (print o get_typs) tyenv
-end
-
-fun pretty_env ctxt env =
-let
-   fun get_trms (v, (T, t)) = (Var (v, T), t)
-   val print = pairself (pretty_term ctxt)
-in
-   pretty_helper (print o get_trms) env
-end
-
-fun prep_trm thy (x, (T, t)) =
-  (cterm_of thy (Var (x, T)), cterm_of thy t)
-
-fun prep_ty thy (x, (S, ty)) =
-  (ctyp_of thy (TVar (x, S)), ctyp_of thy ty)
-
-fun matcher_inst thy pat trm i =
-  let
-     val univ = Unify.matchers thy [(pat, trm)]
-     val env = nth (Seq.list_of univ) i
-     val tenv = Vartab.dest (Envir.term_env env)
-     val tyenv = Vartab.dest (Envir.type_env env)
-  in
-     (map (prep_ty thy) tyenv, map (prep_trm thy) tenv)
-  end
-*}
-
-ML {*
-  let
-     val pat = Logic.strip_imp_concl (prop_of @{thm spec})
-     val trm = @{term "Trueprop (Q True)"}
-     val inst = matcher_inst @{theory} pat trm 1
-  in
-     Drule.instantiate_normalize inst @{thm spec}
-  end
-*}
-
-ML {*
-let
-   val c = Const (@{const_name "plus"}, dummyT)
-   val o = @{term "1::nat"}
-   val v = Free ("x", dummyT)
-in
-   Syntax.check_term @{context} (c $ o $ v)
-end
-*}
-
-ML {*
-   val my_thm =
-   let
-      val assm1 = @{cprop "\<And> (x::nat). P x ==> Q x"}
-      val assm2 = @{cprop "(P::nat => bool) t"}
-
-      val Pt_implies_Qt =
-        Thm.assume assm1
-        |> tap (fn x => pwriteln (Pretty.str (@{make_string} x)))
-        |> Thm.forall_elim @{cterm "t::nat"}
-        |> tap (fn x => pwriteln (Pretty.str (@{make_string} x)))
-
-      val Qt = Thm.implies_elim Pt_implies_Qt (Thm.assume assm2)
-               |> tap (fn x => pwriteln (Pretty.str (@{make_string} x)))
-   in
-      Qt
-      |> Thm.implies_intr assm2
-      |> Thm.implies_intr assm1
-   end
-*}
-
-local_setup {*
-  Local_Theory.note ((@{binding "my_thm"}, []), [my_thm]) #> snd  
-*}
-
-local_setup {*
-  Local_Theory.note ((@{binding "my_thm_simp"},
-        [Attrib.internal (K Simplifier.simp_add)]), [my_thm]) #> snd
-*}
-
-(* pp 62 *)
-
-lemma
-  shows foo_test1: "A \<Longrightarrow> B \<Longrightarrow> C"
-  and   foo_test2: "A \<longrightarrow> B \<longrightarrow> C" sorry
-
-ML {*
-   Thm.reflexive @{cterm "True"}
-    |> Simplifier.rewrite_rule [@{thm True_def}]
-    |> pretty_thm @{context}
-    |> pwriteln
-*}
-
-ML {*
-Object_Logic.rulify @{thm foo_test2}
-*}
-
-
-ML {*
-  val thm =    @{thm foo_test1};
-  thm 
-  |> cprop_of
-  |> Object_Logic.atomize
-  |> (fn x => Raw_Simplifier.rewrite_rule [x] thm)
-*}
-
-ML {*
-  val thm = @{thm list.induct} |> forall_intr_vars;
-  thm |> forall_intr_vars |> cprop_of |> Object_Logic.atomize
-  |> (fn x => Raw_Simplifier.rewrite_rule [x] thm)
-*}
-
-ML {*
-fun atomize_thm thm =
-let
-  val thm' = forall_intr_vars thm
-  val thm'' = Object_Logic.atomize (cprop_of thm')
-in
-  Raw_Simplifier.rewrite_rule [thm''] thm'
-end
-*}
-
-ML {*
-  @{thm list.induct} |> atomize_thm
-*}
-
-ML {*
-   Skip_Proof.make_thm @{theory} @{prop "True = False"}
-*}
-
-ML {*
-fun pthms_of (PBody {thms, ...}) = map #2 thms
-val get_names = map #1 o pthms_of
-val get_pbodies = map (Future.join o #3) o pthms_of
-*}
-
-lemma my_conjIa:
-shows "A \<and> B \<Longrightarrow> A \<and> B"
-apply(rule conjI)
-apply(drule conjunct1)
-apply(assumption)
-apply(drule conjunct2)
-apply(assumption)
-done
-
-lemma my_conjIb:
-shows "A \<and> B \<Longrightarrow> A \<and> B"
-apply(assumption)
-done
-
-lemma my_conjIc:
-shows "A \<and> B \<Longrightarrow> A \<and> B"
-apply(auto)
-done
-
-
-ML {*
-@{thm my_conjIa}
-  |> Thm.proof_body_of
-  |> get_names
-*}
-
-ML {*
-@{thm my_conjIa}
-  |> Thm.proof_body_of
-  |> get_pbodies
-  |> map get_names
-  |> List.concat
-*}
-
-ML {*
-@{thm my_conjIb}
- |> Thm.proof_body_of
- |> get_pbodies
- |> map get_names
- |> List.concat
-*}
-
-ML {*
-@{thm my_conjIc}
-  |> Thm.proof_body_of
-  |> get_pbodies
-  |> map get_names
-  |> List.concat
-*}
-
-ML {*
-@{thm my_conjIa}
-  |> Thm.proof_body_of
-  |> get_pbodies
-  |> map get_pbodies
-  |> (map o map) get_names
-  |> List.concat
-  |> List.concat
-  |> duplicates (op=)
-*}
-
-end
\ No newline at end of file