src/HOL/Nominal/nominal_inductive2.ML
changeset 38549 d0385f2764d8
parent 36960 01594f816e3a
child 38558 32ad17fe2b9c
equal deleted inserted replaced
38548:dea0d2cca822 38549:d0385f2764d8
    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))))