Library MetaCoq.Checker.Weakening



Weakening lemmas for typing derivations.

weakening_× proves weakening of typing, reduction etc... w.r.t. the *local* environment.


Lemma typed_liftn `{checker_flags} Σ Γ t T n k :
  wf Σ.1 wf_local Σ Γ k #|Γ|
  Σ ;;; Γ |- t : T lift n k T = T lift n k t = t.

Definition lift_decl n k d := (map_decl (lift n k) d).

Definition lift_context n k (Γ : context) : context :=
  fold_context (fun k'lift n (k' + k)) Γ.

Lemma lift_decl0 k d : map_decl (lift 0 k) d = d.

Lemma lift0_context k Γ : lift_context 0 k Γ = Γ.

Lemma lift_context_length n k Γ : #|lift_context n k Γ| = #|Γ|.

Definition lift_context_snoc0 n k Γ d : lift_context n k (d :: Γ) = lift_context n k Γ ,, lift_decl n (#|Γ| + k) d.

Lemma lift_context_snoc n k Γ d : lift_context n k (Γ ,, d) = lift_context n k Γ ,, lift_decl n (#|Γ| + k) d.

Lemma lift_context_alt n k Γ :
  lift_context n k Γ =
  mapi (fun k' dlift_decl n (Nat.pred #|Γ| - k' + k) d) Γ.

Lemma lift_context_app n k Γ Δ :
  lift_context n k (Γ ,,, Δ) = lift_context n k Γ ,,, lift_context n (#|Γ| + k) Δ.

Lemma nth_error_lift_context:
   (Γ' Γ'' : context) (v : nat),
    v < #|Γ'| nth k,
    nth_error Γ' v = Some nth
    nth_error (lift_context #|Γ''| k Γ') v = Some (lift_decl #|Γ''| (#|Γ'| - S v + k) nth).

Lemma nth_error_lift_context_eq:
   (Γ' Γ'' : context) (v : nat) k,
    nth_error (lift_context #|Γ''| k Γ') v =
    option_map (lift_decl #|Γ''| (#|Γ'| - S v + k)) (nth_error Γ' v).

Lemma weaken_nth_error_ge {Γ Γ' v Γ''} : #|Γ'| v
  nth_error (Γ ,,, Γ') v =
  nth_error (Γ ,,, Γ'' ,,, lift_context #|Γ''| 0 Γ') (#|Γ''| + v).

Lemma weaken_nth_error_lt {Γ Γ' Γ'' v} : v < #|Γ'|
  nth_error (Γ ,,, Γ'' ,,, lift_context #|Γ''| 0 Γ') v =
  option_map (lift_decl #|Γ''| (#|Γ'| - S v)) (nth_error (Γ ,,, Γ') v).

Lemma lift_simpl {Γ'' Γ' : context} {i t} : i < #|Γ'|
  lift0 (S i) (lift #|Γ''| (#|Γ'| - S i) t) = lift #|Γ''| #|Γ'| (lift0 (S i) t).

Lemma lift_iota_red n k pars c args brs :
  lift n k (iota_red pars c args brs) =
  iota_red pars c (List.map (lift n k) args) (List.map (on_snd (lift n k)) brs).

Lemma parsubst_empty k a : Ast.wf a subst [] k a = a.

Lemma lift_unfold_fix n k mfix idx narg fn :
  unfold_fix mfix idx = Some (narg, fn)
  unfold_fix (map (map_def (lift n k) (lift n (#|mfix| + k))) mfix) idx = Some (narg, lift n k fn).

Lemma lift_unfold_cofix n k mfix idx narg fn :
  unfold_cofix mfix idx = Some (narg, fn)
  unfold_cofix (map (map_def (lift n k) (lift n (#|mfix| + k))) mfix) idx = Some (narg, lift n k fn).

Lemma lift_is_constructor:
   (args : list term) (narg : nat) n k,
    is_constructor narg args = true is_constructor narg (map (lift n k) args) = true.


Lemma lift_declared_constant `{checker_flags} Σ cst decl n k :
  wf Σ
  declared_constant Σ cst decl
  decl = map_constant_body (lift n k) decl.

Definition lift_mutual_inductive_body n k m :=
  map_mutual_inductive_body (fun k'lift n (k' + k)) m.

Lemma lift_wf_local `{checker_flags} Σ Γ n k : wf Σ.1 wf_local Σ Γ lift_context n k Γ = Γ.

Lemma closed_wf_local `{checker_flags} Σ Γ :
  wf Σ.1
  wf_local Σ Γ
  closed_ctx Γ.

Lemma lift_declared_minductive `{checker_flags} Σ cst decl n k :
  wf Σ
  declared_minductive Σ cst decl
  lift_mutual_inductive_body n k decl = decl.

Lemma lift_declared_inductive `{checker_flags} Σ ind mdecl idecl n k :
  wf Σ
  declared_inductive Σ mdecl ind idecl
  map_one_inductive_body (context_assumptions mdecl.(ind_params))
                         (length (arities_context mdecl.(ind_bodies))) (fun k'lift n (k' + k))
                         (inductive_ind ind) idecl = idecl.

Lemma subst0_inds_lift ind u mdecl n k t :
  (subst0 (inds (inductive_mind ind) u (ind_bodies mdecl))
          (lift n (#|arities_context (ind_bodies mdecl)| + k) t)) =
  lift n k (subst0 (inds (inductive_mind ind) u (ind_bodies mdecl)) t).

Lemma lift_declared_constructor `{checker_flags} Σ c u mdecl idecl cdecl n k :
  wf Σ
  declared_constructor Σ mdecl idecl c cdecl
  lift n k (type_of_constructor mdecl cdecl c u) = (type_of_constructor mdecl cdecl c u).

Lemma lift_declared_projection `{checker_flags} Σ c mdecl idecl pdecl n k :
  wf Σ
  declared_projection Σ mdecl idecl c pdecl
  on_snd (lift n (S (ind_npars mdecl + k))) pdecl = pdecl.

Lemma lift_fix_context:
   (mfix : list (def term)) (n k : nat),
    fix_context (map (map_def (lift n k) (lift n (#|mfix| + k))) mfix) = lift_context n k (fix_context mfix).


Lemma All_local_env_lift `{checker_flags}
      (P Q : context term option term Type) c n k :
  All_local_env Q c
  ( Γ t T,
      Q Γ t T
      P (lift_context n k Γ) (lift n (#|Γ| + k) t)
        (option_map (lift n (#|Γ| + k)) T)
  )
  All_local_env P (lift_context n k c).

Lemma lift_destArity ctx t n k : Ast.wf t
        destArity (lift_context n k ctx) (lift n (#|ctx| + k) t) =
        match destArity ctx t with
        | Some (args, s)Some (lift_context n k args, s)
        | NoneNone
        end.

Lemma lift_strip_outer_cast n k t : lift n k (strip_outer_cast t) = strip_outer_cast (lift n k t).

Definition on_pair {A B C D} (f : A B) (g : C D) (x : A × C) :=
  (f (fst x), g (snd x)).

Lemma lift_instantiate_params_subst n k params args s t :
  instantiate_params_subst (mapi_rec (fun k' decllift_decl n (k' + k) decl) params #|s|)
                           (map (lift n k) args) (map (lift n k) s) (lift n (#|s| + k) t) =
  option_map (on_pair (map (lift n k)) (lift n (#|s| + k + #|params|))) (instantiate_params_subst params args s t).

Lemma instantiate_params_subst_length params args s t ctx t' :
  instantiate_params_subst params args s t = Some (ctx, t')
  #|ctx| = #|s| + #|params|.

Lemma lift_decl_closed n k d : closed_decl k d lift_decl n k d = d.

Lemma closed_decl_upwards k d : closed_decl k d k', k k' closed_decl k' d.

Lemma closed_ctx_lift n k ctx : closed_ctx ctx lift_context n k ctx = ctx.

Lemma closed_tele_lift n k ctx :
  closed_ctx ctx
  mapi (fun (k' : nat) (decl : context_decl) ⇒ lift_decl n (k' + k) decl) (List.rev ctx) = List.rev ctx.

Lemma lift_instantiate_params n k params args t :
  closed_ctx params
  option_map (lift n k) (instantiate_params params args t) =
  instantiate_params params (map (lift n k) args) (lift n k t).

Lemma lift_decompose_prod_assum_rec ctx t n k :
  let (ctx', t') := decompose_prod_assum ctx t in
  (lift_context n k ctx', lift n (length ctx' + k) t') =
  decompose_prod_assum (lift_context n k ctx) (lift n (length ctx + k) t).

Lemma lift_decompose_prod_assum t n k :
  let (ctx', t') := decompose_prod_assum [] t in
  (lift_context n k ctx', lift n (length ctx' + k) t') =
  decompose_prod_assum [] (lift n k t).

Lemma decompose_app_lift n k t f a :
  decompose_app t = (f, a) decompose_app (lift n k t) = (lift n k f, map (lift n k) a).

Lemma lift_it_mkProd_or_LetIn n k ctx t :
  lift n k (it_mkProd_or_LetIn ctx t) =
  it_mkProd_or_LetIn (lift_context n k ctx) (lift n (length ctx + k) t).

Lemma to_extended_list_lift n k c :
  to_extended_list (lift_context n k c) = to_extended_list c.

Lemma to_extended_list_map_lift:
   (n k : nat) (c : context), to_extended_list c = map (lift n (#|c| + k)) (to_extended_list c).

Lemma wf_instantiate_params_subst_term :
   params args s t ctx t',
    Ast.wf t
    instantiate_params_subst params args s t = Some (ctx, t')
    Ast.wf t'.

Lemma wf_instantiate_params_subst_ctx :
   params args s t ctx t',
    Forall Ast.wf args
    Forall wf_decl params
    Forall Ast.wf s
    instantiate_params_subst params args s t = Some (ctx, t')
    Forall Ast.wf ctx.

Lemma wf_instantiate_params :
   params args t t',
    Forall wf_decl params
    Forall Ast.wf args
    Ast.wf t
    instantiate_params params args t = Some t'
    Ast.wf t'.

Lemma lift_types_of_case ind mdecl idecl args u p pty indctx pctx ps btys n k :
  let f k' := lift n (k' + k) in
  let f_ctx := lift_context n k in
  Forall wf_decl mdecl.(ind_params)
  Forall Ast.wf args
  Ast.wf pty Ast.wf (ind_type idecl)
  closed_ctx mdecl.(ind_params)
  types_of_case ind mdecl idecl args u p pty = Some (indctx, pctx, ps, btys)
  types_of_case ind mdecl (map_one_inductive_body (context_assumptions mdecl.(ind_params))
                                                  (length (arities_context mdecl.(ind_bodies)))
                                                  f (inductive_ind ind) idecl)
                (map (f 0) args) u (f 0 p) (f 0 pty) =
  Some (f_ctx indctx, f_ctx pctx, ps, map (on_snd (f 0)) btys).

Lemma weakening_red1 `{CF:checker_flags} Σ Γ Γ' Γ'' M N :
  wf Σ
  red1 Σ (Γ ,,, Γ') M N
  red1 Σ (Γ ,,, Γ'' ,,, lift_context #|Γ''| 0 Γ') (lift #|Γ''| #|Γ'| M) (lift #|Γ''| #|Γ'| N).

Lemma lift_eq_term_upto_univ Re Rl n k T U :
  eq_term_upto_univ Re Rl T U
  eq_term_upto_univ Re Rl (lift n k T) (lift n k U).

Lemma lift_eq_term `{checker_flags} ϕ n k T U :
  eq_term ϕ T U eq_term ϕ (lift n k T) (lift n k U).

Lemma lift_leq_term `{checker_flags} ϕ n k T U :
  leq_term ϕ T U leq_term ϕ (lift n k T) (lift n k U).

Lemma weakening_cumul `{CF:checker_flags} Σ Γ Γ' Γ'' M N :
  wf Σ.1
  Σ ;;; Γ ,,, Γ' |- M N
  Σ ;;; Γ ,,, Γ'' ,,, lift_context #|Γ''| 0 Γ' |- lift #|Γ''| #|Γ'| M lift #|Γ''| #|Γ'| N.

Lemma lift_eq_decl `{checker_flags} ϕ n k d d' :
  eq_decl ϕ d d' eq_decl ϕ (lift_decl n k d) (lift_decl n k d').

Lemma lift_eq_context `{checker_flags} φ l l' n k :
  eq_context φ l l'
  eq_context φ (lift_context n k l) (lift_context n k l').

Lemma lift_check_correct_arity:
   (cf : checker_flags) φ (Γ' : context) (ind : inductive) (u : universe_instance)
         (npar : nat) (args : list term) (idecl : one_inductive_body)
         (Γ'' : context) (indctx pctx : list context_decl),
    check_correct_arity φ idecl ind u indctx (firstn npar args) pctx
    check_correct_arity
      φ idecl ind u (lift_context #|Γ''| #|Γ'| indctx) (firstn npar (map (lift #|Γ''| #|Γ'|) args))
      (lift_context #|Γ''| #|Γ'| pctx).

Lemma wf_ind_type `{checker_flags} Σ mdecl ind idecl :
  wf Σ declared_inductive Σ mdecl ind idecl Ast.wf (ind_type idecl).

Lemma destArity_it_mkProd_or_LetIn ctx ctx' t :
  destArity ctx (it_mkProd_or_LetIn ctx' t) =
  destArity (ctx ,,, ctx') t.

Lemma weakening_typing `{cf : checker_flags} Σ Γ Γ' Γ'' (t : term) :
  wf Σ.1
  wf_local Σ (Γ ,,, Γ')
  wf_local Σ (Γ ,,, Γ'' ,,, lift_context #|Γ''| 0 Γ')
  `(Σ ;;; Γ ,,, Γ' |- t : T
    Σ ;;; Γ ,,, Γ'' ,,, lift_context #|Γ''| 0 Γ' |-
    lift #|Γ''| #|Γ'| t : lift #|Γ''| #|Γ'| T).

Lemma weakening `{cf : checker_flags} Σ Γ Γ' (t : term) T :
  wf Σ.1 wf_local Σ (Γ ,,, Γ')
  Σ ;;; Γ |- t : T
  Σ ;;; Γ ,,, Γ' |- lift0 #|Γ'| t : lift0 #|Γ'| T.