diff -r 68245155eb58 -r 6b23a58cc67c src/HOL/Nominal/Examples/W.thy --- a/src/HOL/Nominal/Examples/W.thy Sat Dec 13 13:24:45 2008 +0100 +++ b/src/HOL/Nominal/Examples/W.thy Sat Dec 13 16:26:06 2008 +0100 @@ -1,5 +1,3 @@ -(* "$Id$" *) - theory W imports Nominal begin @@ -50,26 +48,68 @@ Ctxt = "(var\tyS) list" text {* free type variables *} -consts - ftv :: "'a \ tvar list" + +class ftv = type + + fixes ftv :: "'a \ tvar list" + +instantiation * :: (ftv, ftv) ftv +begin + +primrec ftv_prod +where + "ftv (x::'a::ftv, y::'b::ftv) = (ftv x)@(ftv y)" + +instance .. + +end -primrec (ftv_of_prod) - "ftv (x,y) = (ftv x)@(ftv y)" +instantiation tvar :: ftv +begin + +definition + ftv_of_tvar[simp]: "ftv X \ [(X::tvar)]" -defs (overloaded) - ftv_of_tvar[simp]: "ftv X \ [(X::tvar)]" +instance .. + +end + +instantiation var :: ftv +begin + +definition ftv_of_var[simp]: "ftv (x::var) \ []" -primrec (ftv_of_list) +instance .. + +end + +instantiation list :: (ftv) ftv +begin + +primrec ftv_list +where "ftv [] = []" - "ftv (x#xs) = (ftv x)@(ftv xs)" +| "ftv (x#xs) = (ftv x)@(ftv xs)" + +instance .. + +end (* free type-variables of types *) -nominal_primrec (ftv_ty) + +instantiation ty :: ftv +begin + +nominal_primrec ftv_ty +where "ftv (TVar X) = [X]" - "ftv (T\<^isub>1\T\<^isub>2) = (ftv T\<^isub>1)@(ftv T\<^isub>2)" +| "ftv (T\<^isub>1\T\<^isub>2) = (ftv T\<^isub>1)@(ftv T\<^isub>2)" by (rule TrueI)+ +instance .. + +end + lemma ftv_ty_eqvt[eqvt]: fixes pi::"tvar prm" and T::"ty" @@ -77,9 +117,13 @@ by (nominal_induct T rule: ty.strong_induct) (perm_simp add: append_eqvt)+ -nominal_primrec (ftv_tyS) +instantiation tyS :: ftv +begin + +nominal_primrec ftv_tyS +where "ftv (Ty T) = ftv T" - "ftv (\[X].S) = (ftv S) - [X]" +| "ftv (\[X].S) = (ftv S) - [X]" apply(finite_guess add: ftv_ty_eqvt fs_tvar1)+ apply(rule TrueI)+ apply(rule difference_fresh) @@ -87,6 +131,10 @@ apply(fresh_guess add: ftv_ty_eqvt fs_tvar1)+ done +instance .. + +end + lemma ftv_tyS_eqvt[eqvt]: fixes pi::"tvar prm" and S::"tyS" @@ -140,11 +188,11 @@ types Subst = "(tvar\ty) list" -consts - psubst :: "Subst \ 'a \ 'a" ("_<_>" [100,60] 120) +class psubst = + fixes psubst :: "Subst \ 'a \ 'a" ("_<_>" [100,60] 120) abbreviation - subst :: "'a \ tvar \ ty \ 'a" ("_[_::=_]" [100,100,100] 100) + subst :: "'a::psubst \ tvar \ ty \ 'a" ("_[_::=_]" [100,100,100] 100) where "smth[X::=T] \ ([(X,T)])" @@ -159,11 +207,19 @@ shows "pi\(lookup \ X) = lookup (pi\\) (pi\X)" by (induct \) (auto simp add: eqvts) -nominal_primrec (psubst_ty) +instantiation ty :: psubst +begin + +nominal_primrec psubst_ty +where "\ = lookup \ X" - "\1 \ T\<^isub>2> = (\1>) \ (\2>)" +| "\1 \ T\<^isub>2> = (\1>) \ (\2>)" by (rule TrueI)+ +instance .. + +end + lemma psubst_ty_eqvt[eqvt]: fixes pi1::"tvar prm" and \::"Subst"