Theory Pure_term

Up to index of Isabelle/HOL/ex

theory Pure_term
imports Code_Message
begin

(*  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

Definitions

ML interface

Code generator setup

lemma

  (tyco1.0 {\<struct>} tys1.0 = tyco2.0 {\<struct>} tys2.0) =
  (tyco1.0 = tyco2.0list_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_stringtyp) =
  f2.0 message_string typ
  term_rec f1.0 f2.0 f3.0 f4.0 f5.0 (term1.0term2.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_stringtyp) =
  f2.0 message_string typ
  term_case f1.0 f2.0 f3.0 f4.0 f5.0 (term1.0term2.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_stringtyp) = 0
  size (term1.0term2.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)