(* Title: HOL/Library/Pure_term.thy ID: $Id: Pure_term.thy,v 1.8 2007/10/12 06:21:11 haftmann Exp $ Author: Florian Haftmann, TU Muenchen *) header {* Embedding (a subset of) the Pure term algebra in HOL *} theory Pure_term imports Code_Message begin subsection {* Definitions *} types vname = message_string; types "class" = message_string; types sort = "class list" datatype "typ" = Type message_string "typ list" (infix "{\<struct>}" 120) | TFix vname sort (infix "::ε" 117) abbreviation Fun :: "typ => typ => typ" (infixr "->" 115) where "ty1 -> ty2 ≡ Type (STR ''fun'') [ty1, ty2]" abbreviation Funs :: "typ list => typ => typ" (infixr "{->}" 115) where "tys {->} ty ≡ foldr (op ->) tys ty" datatype "term" = Const message_string "typ" (infix "::⊆" 112) | Fix vname "typ" (infix ":ε" 112) | App "term" "term" (infixl "•" 110) | Abs "vname × typ" "term" (infixr "\<mapsto>" 111) | Bnd nat abbreviation Apps :: "term => term list => term" (infixl "{•}" 110) where "t {•} ts ≡ foldl (op •) t ts" abbreviation Abss :: "(vname × typ) list => term => term" (infixr "{\<mapsto>}" 111) where "vs {\<mapsto>} t ≡ foldr (op \<mapsto>) vs t" subsection {* ML interface *} ML {* structure Pure_term = struct val mk_sort = HOLogic.mk_list @{typ class} o map Message_String.mk; fun mk_typ f (Type (tyco, tys)) = @{term Type} $ Message_String.mk tyco $ HOLogic.mk_list @{typ typ} (map (mk_typ f) tys) | mk_typ f (TFree v) = f v; fun mk_term f g (Const (c, ty)) = @{term Const} $ Message_String.mk c $ g ty | mk_term f g (t1 $ t2) = @{term App} $ mk_term f g t1 $ mk_term f g t2 | mk_term f g (Free v) = f v; end; *} subsection {* Code generator setup *} lemma [code func]: "tyco1 {\<struct>} tys1 = tyco2 {\<struct>} tys2 <-> tyco1 = tyco2 ∧ list_all2 (op =) tys1 tys2" by (auto simp add: list_all2_eq [symmetric]) code_datatype Const App Fix lemmas [code func del] = term.recs term.cases term.size lemma [code func, code func del]: "(t1::term) = t2 <-> t1 = t2" .. code_type "typ" and "term" (SML "Term.typ" and "Term.term") code_const Type and TFix (SML "Term.Type/ (_, _)" and "Term.TFree/ (_, _)") code_const Const and App and Fix (SML "Term.Const/ (_, _)" and "Term.$/ (_, _)" and "Term.Free/ (_, _)") code_reserved SML Term end
lemma
(tyco1.0 {\<struct>} tys1.0 = tyco2.0 {\<struct>} tys2.0) =
(tyco1.0 = tyco2.0 ∧ list_all2 op = tys1.0 tys2.0)
lemma
term_rec f1.0 f2.0 f3.0 f4.0 f5.0 (message_string ::⊆ typ) =
f1.0 message_string typ
term_rec f1.0 f2.0 f3.0 f4.0 f5.0 (message_string :ε typ) =
f2.0 message_string typ
term_rec f1.0 f2.0 f3.0 f4.0 f5.0 (term1.0 • term2.0) =
f3.0 term1.0 term2.0 (term_rec f1.0 f2.0 f3.0 f4.0 f5.0 term1.0)
(term_rec f1.0 f2.0 f3.0 f4.0 f5.0 term2.0)
term_rec f1.0 f2.0 f3.0 f4.0 f5.0 (x \<mapsto> term) =
f4.0 x term (term_rec f1.0 f2.0 f3.0 f4.0 f5.0 term)
term_rec f1.0 f2.0 f3.0 f4.0 f5.0 (Bnd nat) = f5.0 nat
term_case f1.0 f2.0 f3.0 f4.0 f5.0 (message_string ::⊆ typ) =
f1.0 message_string typ
term_case f1.0 f2.0 f3.0 f4.0 f5.0 (message_string :ε typ) =
f2.0 message_string typ
term_case f1.0 f2.0 f3.0 f4.0 f5.0 (term1.0 • term2.0) = f3.0 term1.0 term2.0
term_case f1.0 f2.0 f3.0 f4.0 f5.0 (x \<mapsto> term) = f4.0 x term
term_case f1.0 f2.0 f3.0 f4.0 f5.0 (Bnd nat) = f5.0 nat
size (message_string ::⊆ typ) = 0
size (message_string :ε typ) = 0
size (term1.0 • term2.0) = size term1.0 + size term2.0 + Suc 0
size (x \<mapsto> term) = size term + Suc 0
size (Bnd nat) = 0
lemma
(t1.0 = t2.0) = (t1.0 = t2.0)