19 |
19 |
20 val cont_K = @{thm cont_const}; |
20 val cont_K = @{thm cont_const}; |
21 val cont_I = @{thm cont_id}; |
21 val cont_I = @{thm cont_id}; |
22 val cont_A = @{thm cont2cont_APP}; |
22 val cont_A = @{thm cont2cont_APP}; |
23 val cont_L = @{thm cont2cont_LAM}; |
23 val cont_L = @{thm cont2cont_LAM}; |
24 val cont_R = @{thm cont_Rep_CFun2}; |
24 val cont_R = @{thm cont_Rep_cfun2}; |
25 |
25 |
26 (* checks whether a term contains no dangling bound variables *) |
26 (* checks whether a term contains no dangling bound variables *) |
27 fun is_closed_term t = not (Term.loose_bvar (t, 0)); |
27 fun is_closed_term t = not (Term.loose_bvar (t, 0)); |
28 |
28 |
29 (* checks whether a term is written entirely in the LCF sublanguage *) |
29 (* checks whether a term is written entirely in the LCF sublanguage *) |
30 fun is_lcf_term (Const (@{const_name Rep_CFun}, _) $ t $ u) = |
30 fun is_lcf_term (Const (@{const_name Rep_cfun}, _) $ t $ u) = |
31 is_lcf_term t andalso is_lcf_term u |
31 is_lcf_term t andalso is_lcf_term u |
32 | is_lcf_term (Const (@{const_name Abs_CFun}, _) $ Abs (_, _, t)) = |
32 | is_lcf_term (Const (@{const_name Abs_cfun}, _) $ Abs (_, _, t)) = |
33 is_lcf_term t |
33 is_lcf_term t |
34 | is_lcf_term (Const (@{const_name Abs_CFun}, _) $ t) = |
34 | is_lcf_term (Const (@{const_name Abs_cfun}, _) $ t) = |
35 is_lcf_term (Term.incr_boundvars 1 t $ Bound 0) |
35 is_lcf_term (Term.incr_boundvars 1 t $ Bound 0) |
36 | is_lcf_term (Bound _) = true |
36 | is_lcf_term (Bound _) = true |
37 | is_lcf_term t = is_closed_term t; |
37 | is_lcf_term t = is_closed_term t; |
38 |
38 |
39 (* |
39 (* |
65 in (map (fn y => SOME (k y RS Lx)) ys, x') end; |
65 in (map (fn y => SOME (k y RS Lx)) ys, x') end; |
66 |
66 |
67 (* first list: cont thm for each dangling bound variable *) |
67 (* first list: cont thm for each dangling bound variable *) |
68 (* second list: cont thm for each LAM in t *) |
68 (* second list: cont thm for each LAM in t *) |
69 (* if b = false, only return cont thm for outermost LAMs *) |
69 (* if b = false, only return cont thm for outermost LAMs *) |
70 fun cont_thms1 b (Const (@{const_name Rep_CFun}, _) $ f $ t) = |
70 fun cont_thms1 b (Const (@{const_name Rep_cfun}, _) $ f $ t) = |
71 let |
71 let |
72 val (cs1,ls1) = cont_thms1 b f; |
72 val (cs1,ls1) = cont_thms1 b f; |
73 val (cs2,ls2) = cont_thms1 b t; |
73 val (cs2,ls2) = cont_thms1 b t; |
74 in (zip cs1 cs2, if b then ls1 @ ls2 else []) end |
74 in (zip cs1 cs2, if b then ls1 @ ls2 else []) end |
75 | cont_thms1 b (Const (@{const_name Abs_CFun}, _) $ Abs (_, _, t)) = |
75 | cont_thms1 b (Const (@{const_name Abs_cfun}, _) $ Abs (_, _, t)) = |
76 let |
76 let |
77 val (cs, ls) = cont_thms1 b t; |
77 val (cs, ls) = cont_thms1 b t; |
78 val (cs', l) = lam cs; |
78 val (cs', l) = lam cs; |
79 in (cs', l::ls) end |
79 in (cs', l::ls) end |
80 | cont_thms1 b (Const (@{const_name Abs_CFun}, _) $ t) = |
80 | cont_thms1 b (Const (@{const_name Abs_cfun}, _) $ t) = |
81 let |
81 let |
82 val t' = Term.incr_boundvars 1 t $ Bound 0; |
82 val t' = Term.incr_boundvars 1 t $ Bound 0; |
83 val (cs, ls) = cont_thms1 b t'; |
83 val (cs, ls) = cont_thms1 b t'; |
84 val (cs', l) = lam cs; |
84 val (cs', l) = lam cs; |
85 in (cs', l::ls) end |
85 in (cs', l::ls) end |
107 [] => no_tac |
107 [] => no_tac |
108 | (c::cs) => rtac c i; |
108 | (c::cs) => rtac c i; |
109 |
109 |
110 fun cont_tac_of_term (Const (@{const_name cont}, _) $ f) = |
110 fun cont_tac_of_term (Const (@{const_name cont}, _) $ f) = |
111 let |
111 let |
112 val f' = Const (@{const_name Abs_CFun}, dummyT) $ f; |
112 val f' = Const (@{const_name Abs_cfun}, dummyT) $ f; |
113 in |
113 in |
114 if is_lcf_term f' |
114 if is_lcf_term f' |
115 then new_cont_tac f' |
115 then new_cont_tac f' |
116 else REPEAT_ALL_NEW (resolve_tac rules) |
116 else REPEAT_ALL_NEW (resolve_tac rules) |
117 end |
117 end |