73 | _ => fold (add_binders thy i) ts bs) |
73 | _ => fold (add_binders thy i) ts bs) |
74 | (u, ts) => add_binders thy i u (fold (add_binders thy i) ts bs)) |
74 | (u, ts) => add_binders thy i u (fold (add_binders thy i) ts bs)) |
75 | add_binders thy i (Abs (_, _, t)) bs = add_binders thy (i + 1) t bs |
75 | add_binders thy i (Abs (_, _, t)) bs = add_binders thy (i + 1) t bs |
76 | add_binders thy i _ bs = bs; |
76 | add_binders thy i _ bs = bs; |
77 |
77 |
78 fun split_conj f names (Const ("op &", _) $ p $ q) _ = (case head_of p of |
78 fun split_conj f names (Const (@{const_name "op &"}, _) $ p $ q) _ = (case head_of p of |
79 Const (name, _) => |
79 Const (name, _) => |
80 if member (op =) names name then SOME (f p q) else NONE |
80 if member (op =) names name then SOME (f p q) else NONE |
81 | _ => NONE) |
81 | _ => NONE) |
82 | split_conj _ _ _ _ = NONE; |
82 | split_conj _ _ _ _ = NONE; |
83 |
83 |
84 fun strip_all [] t = t |
84 fun strip_all [] t = t |
85 | strip_all (_ :: xs) (Const ("All", _) $ Abs (s, T, t)) = strip_all xs t; |
85 | strip_all (_ :: xs) (Const (@{const_name "All"}, _) $ Abs (s, T, t)) = strip_all xs t; |
86 |
86 |
87 (*********************************************************************) |
87 (*********************************************************************) |
88 (* maps R ... & (ALL pi_1 ... pi_n z. P z (pi_1 o ... o pi_n o t)) *) |
88 (* maps R ... & (ALL pi_1 ... pi_n z. P z (pi_1 o ... o pi_n o t)) *) |
89 (* or ALL pi_1 ... pi_n z. P z (pi_1 o ... o pi_n o t) *) |
89 (* or ALL pi_1 ... pi_n z. P z (pi_1 o ... o pi_n o t) *) |
90 (* to R ... & id (ALL z. P z (pi_1 o ... o pi_n o t)) *) |
90 (* to R ... & id (ALL z. P z (pi_1 o ... o pi_n o t)) *) |
91 (* or id (ALL z. P z (pi_1 o ... o pi_n o t)) *) |
91 (* or id (ALL z. P z (pi_1 o ... o pi_n o t)) *) |
92 (* *) |
92 (* *) |
93 (* where "id" protects the subformula from simplification *) |
93 (* where "id" protects the subformula from simplification *) |
94 (*********************************************************************) |
94 (*********************************************************************) |
95 |
95 |
96 fun inst_conj_all names ps pis (Const ("op &", _) $ p $ q) _ = |
96 fun inst_conj_all names ps pis (Const (@{const_name "op &"}, _) $ p $ q) _ = |
97 (case head_of p of |
97 (case head_of p of |
98 Const (name, _) => |
98 Const (name, _) => |
99 if member (op =) names name then SOME (HOLogic.mk_conj (p, |
99 if member (op =) names name then SOME (HOLogic.mk_conj (p, |
100 Const ("Fun.id", HOLogic.boolT --> HOLogic.boolT) $ |
100 Const ("Fun.id", HOLogic.boolT --> HOLogic.boolT) $ |
101 (subst_bounds (pis, strip_all pis q)))) |
101 (subst_bounds (pis, strip_all pis q)))) |