Nominal/Ex/Lambda.thy
changeset 2846 1d43d30e44c9
parent 2845 a99f488a96bb
child 2852 f884760ac6e2
--- a/Nominal/Ex/Lambda.thy	Fri Jun 10 15:45:49 2011 +0900
+++ b/Nominal/Ex/Lambda.thy	Fri Jun 10 15:52:17 2011 +0900
@@ -605,6 +605,52 @@
 oops (* can this be defined ? *)
   (* Yes, if "sub" is a constant. *)
 
+text {* Working Examples *}
+
+nominal_primrec
+  map_term :: "(lam \<Rightarrow> lam) \<Rightarrow> lam \<Rightarrow> lam"
+where
+  "eqvt f \<Longrightarrow> map_term f (Var x) = f (Var x)"
+| "eqvt f \<Longrightarrow> map_term f (App t1 t2) = App (f t1) (f t2)"
+| "eqvt f \<Longrightarrow> map_term f (Lam [x].t) = Lam [x].(f t)"
+| "\<not>eqvt f \<Longrightarrow> map_term f t = t"
+  apply (simp add: eqvt_def map_term_graph_def)
+  apply (rule, perm_simp, rule)
+  apply(rule TrueI)
+  apply (case_tac x, case_tac "eqvt a", case_tac b rule: lam.exhaust)
+  apply auto
+  apply (erule Abs_lst1_fcb)
+  apply (simp_all add: Abs_fresh_iff fresh_fun_eqvt_app)
+  apply (simp add: eqvt_def permute_fun_app_eq)
+  done
+
+termination
+  by (relation "measure (\<lambda>(_,t). size t)") (simp_all add: lam.size)
+
+nominal_primrec
+  trans2 :: "lam \<Rightarrow> atom list \<Rightarrow> db option"
+where
+  "trans2 (Var x) xs = (index xs 0 (atom x) \<guillemotright>= (\<lambda>n. Some (DBVar n)))"
+| "trans2 (App t1 t2) xs = ((trans2 t1 xs) \<guillemotright>= (\<lambda>db1. (trans2 t2 xs) \<guillemotright>= (\<lambda>db2. Some (DBApp db1 db2))))"
+| "trans2 (Lam [x].t) xs = (trans2 t (atom x # xs) \<guillemotright>= (\<lambda>db. Some (DBLam db)))"
+oops
+
+nominal_primrec
+  CPS :: "lam \<Rightarrow> (lam \<Rightarrow> lam) \<Rightarrow> lam"
+where
+  "CPS (Var x) k = Var x"
+| "CPS (App M N) k = CPS M (\<lambda>m. CPS N (\<lambda>n. n))"
+oops
+
+consts b :: name
+nominal_primrec
+  Z :: "lam \<Rightarrow> (lam \<Rightarrow> lam) \<Rightarrow> lam"
+where
+  "Z (App M N) k = Z M (%m. (Z N (%n.(App m n))))"
+| "Z (App M N) k = Z M (%m. (Z N (%n.(App (App m n) (Abs b (k (Var b)))))))"
+unfolding eqvt_def Z_graph_def
+apply (rule, perm_simp, rule)
+oops
 
 text {* tests of functions containing if and case *}
 
@@ -626,26 +672,6 @@
 | "C (App M N) = (if True then M else C N)"
 oops
 
-nominal_primrec
-  map_term :: "(lam \<Rightarrow> lam) \<Rightarrow> lam \<Rightarrow> lam"
-where
-  "eqvt f \<Longrightarrow> map_term f (Var x) = f (Var x)"
-| "eqvt f \<Longrightarrow> map_term f (App t1 t2) = App (f t1) (f t2)"
-| "eqvt f \<Longrightarrow> map_term f (Lam [x].t) = Lam [x].(f t)"
-| "\<not>eqvt f \<Longrightarrow> map_term f t = t"
-  apply (simp add: eqvt_def map_term_graph_def)
-  apply (rule, perm_simp, rule)
-  apply(rule TrueI)
-  apply (case_tac x, case_tac "eqvt a", case_tac b rule: lam.exhaust)
-  apply auto
-  apply (erule Abs_lst1_fcb)
-  apply (simp_all add: Abs_fresh_iff fresh_fun_eqvt_app)
-  apply (simp add: eqvt_def permute_fun_app_eq)
-  done
-
-termination
-  by (relation "measure (\<lambda>(_,t). size t)") (simp_all add: lam.size)
-
 nominal_primrec  
   A :: "lam => lam"
 where  
@@ -667,41 +693,6 @@
 apply(rule refl)
 oops
 
-text {* "HO" functions *}
-
-nominal_primrec
-  trans2 :: "lam \<Rightarrow> atom list \<Rightarrow> db option"
-where
-  "trans2 (Var x) xs = (index xs 0 (atom x) \<guillemotright>= (\<lambda>n. Some (DBVar n)))"
-| "trans2 (App t1 t2) xs = ((trans2 t1 xs) \<guillemotright>= (\<lambda>db1. (trans2 t2 xs) \<guillemotright>= (\<lambda>db2. Some (DBApp db1 db2))))"
-| "trans2 (Lam [x].t) xs = (trans2 t (atom x # xs) \<guillemotright>= (\<lambda>db. Some (DBLam db)))"
-oops
-
-nominal_primrec
-  CPS :: "lam \<Rightarrow> (lam \<Rightarrow> lam) \<Rightarrow> lam"
-where
-  "CPS (Var x) k = Var x"
-| "CPS (App M N) k = CPS M (\<lambda>m. CPS N (\<lambda>n. n))"
-oops
-
-(* Problem: nominal_primrec generates non-quantified free variable "x" *)
-consts b :: name
-nominal_primrec
-  Z :: "lam \<Rightarrow> (lam \<Rightarrow> lam) \<Rightarrow> lam"
-where
-  "Z (App M N) k = Z M (%m. (Z N (%n.(App m n))))"
-| "Z (App M N) k = Z M (%m. (Z N (%n.(App (App m n) (Abs b (k (Var b)))))))"
-unfolding eqvt_def Z_graph_def
-apply (rule, perm_simp, rule)
-oops
-
-
-
-
-
-
-
-
 end