# HG changeset patch # User Cezary Kaliszyk # Date 1307688737 -32400 # Node ID 1d43d30e44c958a6c1891f711998809d0e8649ed # Parent a99f488a96bbc7c97efd813d4e33ebf0657a9349 Move working examples before non-working ones diff -r a99f488a96bb -r 1d43d30e44c9 Nominal/Ex/Lambda.thy --- 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 \ lam) \ lam \ lam" +where + "eqvt f \ map_term f (Var x) = f (Var x)" +| "eqvt f \ map_term f (App t1 t2) = App (f t1) (f t2)" +| "eqvt f \ map_term f (Lam [x].t) = Lam [x].(f t)" +| "\eqvt f \ 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 (\(_,t). size t)") (simp_all add: lam.size) + +nominal_primrec + trans2 :: "lam \ atom list \ db option" +where + "trans2 (Var x) xs = (index xs 0 (atom x) \= (\n. Some (DBVar n)))" +| "trans2 (App t1 t2) xs = ((trans2 t1 xs) \= (\db1. (trans2 t2 xs) \= (\db2. Some (DBApp db1 db2))))" +| "trans2 (Lam [x].t) xs = (trans2 t (atom x # xs) \= (\db. Some (DBLam db)))" +oops + +nominal_primrec + CPS :: "lam \ (lam \ lam) \ lam" +where + "CPS (Var x) k = Var x" +| "CPS (App M N) k = CPS M (\m. CPS N (\n. n))" +oops + +consts b :: name +nominal_primrec + Z :: "lam \ (lam \ lam) \ 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 \ lam) \ lam \ lam" -where - "eqvt f \ map_term f (Var x) = f (Var x)" -| "eqvt f \ map_term f (App t1 t2) = App (f t1) (f t2)" -| "eqvt f \ map_term f (Lam [x].t) = Lam [x].(f t)" -| "\eqvt f \ 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 (\(_,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 \ atom list \ db option" -where - "trans2 (Var x) xs = (index xs 0 (atom x) \= (\n. Some (DBVar n)))" -| "trans2 (App t1 t2) xs = ((trans2 t1 xs) \= (\db1. (trans2 t2 xs) \= (\db2. Some (DBApp db1 db2))))" -| "trans2 (Lam [x].t) xs = (trans2 t (atom x # xs) \= (\db. Some (DBLam db)))" -oops - -nominal_primrec - CPS :: "lam \ (lam \ lam) \ lam" -where - "CPS (Var x) k = Var x" -| "CPS (App M N) k = CPS M (\m. CPS N (\n. n))" -oops - -(* Problem: nominal_primrec generates non-quantified free variable "x" *) -consts b :: name -nominal_primrec - Z :: "lam \ (lam \ lam) \ 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