Require Import Coq.Lists.List.
Import ListNotations.
Require Import Coq.Strings.String.
Require Import StructTact.StructTactics.
Require Import Omega.
Require Import Coq.Logic.Eqdep_dec.
Require Import Equations.Equations.

Require Import CakeSem.Utils.
Require Import FFI.
Require Import CakeSem.Namespace.
Require Import CakeSem.CakeAST.
Require Import CakeSem.SemanticsAux.
Require Import CakeSem.Evaluate.

Require Import BasisPlus.
Require Import BasisEvaluated.

(* Definition init_env : sem_env val := empty_sem_env. *)
(* Definition init_store := empty_store val. *)
(* Parameter init_ffi_st : ffi_state nat. *)
(* Definition init_state := Build_state 0 init_store init_ffi_st 0 0. *)

Theorem evaluate_decs_Dmod : forall (fuel : nat) (mn : modN) (st st' : state nat) (env env' : sem_env val) (ds : list dec),
    evaluate_decs fuel st env ds = (st', Rval env') ->
    evaluate_decs fuel st env [Dmod mn ds] = (st', Rval {| sev := nsLift mn (sev env'); sec := nsLift mn (sec env') |}).
Proof.
  intros.
  simp evaluate_decs.
  rewrite H.
  reflexivity.
Qed.

Theorem evaluate_decs_Dlocal : forall (fuel : nat) (st st' st'' : state nat) (env env' env'' : sem_env val) (ds1 ds2 : list dec),
    evaluate_decs fuel st env ds1 = (st', Rval env') ->
    evaluate_decs fuel st' (extend_dec_env env' env) ds2 = (st'', Rval env'') ->
    evaluate_decs fuel st env [Dlocal ds1 ds2] = (st'', Rval env'').
Proof.
  intros.
  simp evaluate_decs.
  rewrite H.
  simpl.
  rewrite H0.
  reflexivity.
Qed.

Theorem extend_empty_r : forall V (env : sem_env V),
    extend_dec_env env {| sev := nsEmpty; sec := nsEmpty |} = env.
Proof.
  intros.
  destruct env.
  unfold extend_dec_env.
  unfold nsAppend.
  simpl.
  unfold nsEmpty.
  repeat rewrite app_nil_r.
  reflexivity.
Qed.

Theorem extend_empty_l : forall V (env : sem_env V),
    extend_dec_env {| sev := nsEmpty; sec := nsEmpty |} env = env.
Proof.
  intros.
  destruct env.
  unfold extend_dec_env.
  unfold nsAppend.
  reflexivity.
Qed.

Theorem evaluate_0_26_correct :
  evaluate_decs 100 init_state init_env prog_0_26 =
  (st_0_26, Rval env_0_26).
Proof.
  reflexivity.
Qed.

Theorem evaluate_0_27_correct :
  evaluate_decs 100 init_state init_env (prog_0_26 ++ [dec_def_27]) =
  (st_0_26, Rval env_27).
Proof.
  reflexivity.
Qed.

Theorem evaluate_0_29_correct :
  evaluate_decs 100 init_state init_env (prog_0_26 ++ [dec_def_27; dec_def_28; dec_def_29]) =
  (st_0_26, Rval env_28_29).
Proof.
  reflexivity.
Qed.

(* Theorem evaluate_0_30_correct : *)
(*   evaluate_decs 100 init_state init_env (prog_0_26 ++ [dec_def_27; dec_def_28; dec_def_29; dec_def_30]) = *)
(*   (st_0_26, Rval env_30). *)
(* Proof. *)
(*   reflexivity. *)
(* Qed. *)

Ltac evaluate_decs_one :=
  match goal with
  | [|- evaluate_decs _ _ _ [?def] = (_, Rval _)] =>
    unfold def;
    match goal with
    | [|- evaluate_decs _ _ _ [Dmod _ _] = (_, Rval _)]   => erewrite evaluate_decs_Dmod
    | [|- evaluate_decs _ _ _ [Dlocal _ _] = (_, Rval _)] => erewrite evaluate_decs_Dlocal
    | [|- evaluate_decs _ _ _ [_] = (_, Rval _)] => simp evaluate_decs
    end; try reflexivity
  end.

Ltac evaluate_decs_noapp :=
  match goal with
  | [|- evaluate_decs _ _ _ [] = (_, Rval _)] => simp evaluate_decs; reflexivity
  | [|- evaluate_decs _ _ _ [_] = (_, Rval _)] => evaluate_decs_one
  | [|- evaluate_decs _ _ _ (?def::_) = (_, Rval _)] =>
    eapply evaluate_decs_cons'; [evaluate_decs_one | unfold extend_dec_env; simpl]
  end.

Transparent evaluate_decs.
Eval compute in evaluate_decs 100 init_state init_env prog.

Theorem evaluate_30 : exists env st,
    evaluate_decs 100 st_0_26 env_28_29 [dec_def_30; dec_def_31] =
    (st, Rval env).
Proof.
  econstructor; econstructor.

  Transparent evaluate_decs.

  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  (* HERE *)
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  evaluate_decs_noapp.
  eapply evaluate_decs_cons'.

  + unfold dec_def_30;
      erewrite evaluate_decs_Dmod; [reflexivity | simpl].

  eapply evaluate_decs_cons'.
  unfold dec_def_30_0;
    simp evaluate_decs; simpl;
      reflexivity.
  rewrite extend_empty_l.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_1;
    simp evaluate_decs; simpl;
      reflexivity.
  unfold extend_dec_env.
      simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_2.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_3.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_4.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_5.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_6.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_7.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_8.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_9.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_2.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_2_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2_2.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_2_2_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2_2_2.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_2_2_2_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2_2_2_2.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_2_2_2_2_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_2.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_3.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_4.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2_2_2_2_5.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_2_2_2_2_5_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_5_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_5_2.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_5_3.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_5_4.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  eapply evaluate_decs_cons'.
  unfold dec_def_30_10_3_2_2_2_2_5_5.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2_2_2_2_5_6.
  erewrite evaluate_decs_Dlocal.
  reflexivity.

  unfold dec_def_30_10_3_2_2_2_2_5_6_0.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env.
  simpl.

  unfold dec_def_30_10_3_2_2_2_2_5_6_1.
  simp evaluate_decs; simpl.
  reflexivity.
  unfold extend_dec_env at 1.
  simpl.

Qed.

(* Theorem evaluate_0_26 : exists env st, *)
(*     evaluate_decs 100 init_state init_env prog_0_26 = *)
(*     (st, Rval env). *)
(* Proof. *)
(*   econstructor. econstructor. *)
(*   unfold prog_0_26. *)
(*   unfold init_state. *)
(*   unfold init_env. *)
(*   unfold empty_sem_env. *)
(*   unfold nsEmpty. *)
(*   simpl. *)
(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_2. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_4. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_5. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_6. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_7. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_8. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_9. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_10. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_11. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_12. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_13. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_14. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_15. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_16. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_17. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_18. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_19. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_20. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_21. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_22. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_23. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_24. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25. (* Runtime Module (5 subdefs) *) *)
(*   erewrite evaluate_decs_Dmod. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25_2. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25_4. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_25_5. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   simp evaluate_decs; simpl. *)

(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26. (* Option module *) *)
(*   erewrite evaluate_decs_Dmod. *)
(*   reflexivity. *)
(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_2. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_4. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_5. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_6. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_7. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_8. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_9. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_26_10. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold state_update_next_type_stamp. *)
(*   simpl. *)

(*   unfold dec_def_26_11. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)

(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(* Qed. *)

(* Theorem evaluate_27 : exists env st, *)
(*     evaluate_decs 100 st_0_26 env_0_26 [dec_def_27] = *)
(*     (st, Rval env). *)
(*   econstructor. econstructor. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27. *)
(*   eapply evaluate_decs_Dmod. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   unfold dec_def_27_2. (* First Dlocal *) *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_27_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   unfold build_rec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_27_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_27_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; simpl. *)
(*   unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_2. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_4. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_5. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_6. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_7. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_8. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_9. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_10. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; simpl. *)
(*   unfold nsBind. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_11. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_12. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_13. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_14. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env. *)
(*   simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_27_2_2_15_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_2. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_3. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_4. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_5. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_27_2_2_15_6. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   unfold dec_def_27_2_2_15_6_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_2. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_27_2_2_15_6_3. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   unfold dec_def_27_2_2_15_6_3_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_2. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_3. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_4. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_5. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_6. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_27_2_2_15_6_3_7_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_2. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_4. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_5. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_6. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_7. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_8. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_9. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_10. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_11. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_12. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_13. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_14. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_15. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_16. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_27_2_2_15_6_3_7_17. *)

(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_27_2_2_15_6_3_7_17_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_27_2_2_15_6_3_7_17_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_27_2_2_15_6_3_7_17_2. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env at 1. *)
(*   simpl. *)

(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)

(*   unfold extend_dec_env at 1. *)
(*   simpl. *)

(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(* Qed. *)

(* Theorem evaluate_28_29 : exists env st, *)
(*     evaluate_decs 100 st_0_26 env_27 [dec_def_28; dec_def_29] = *)
(*     (st, Rval env). *)
(*   econstructor. econstructor. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28. (* AList Module *) *)
(*   erewrite evaluate_decs_Dmod. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28_2. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28_4. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_28_5. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)

(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29. (* Vector module *) *)
(*   erewrite evaluate_decs_Dmod. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_0. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_2. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_4. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_29_5_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_2. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_3. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_4. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_5. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   unfold dec_def_29_5_6_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   unfold dec_def_29_5_6_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   unfold dec_def_29_5_6_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)
(*   unfold dec_def_29_5_6_2_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_29_5_6_2_2_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_2_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_2_2_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_2_2_2_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   eapply evaluate_decs_cons'. *)
(*   unfold dec_def_29_5_6_2_2_2_2_2_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2_2_2. *)
(*   erewrite evaluate_decs_Dlocal. *)
(*   reflexivity. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2_2_2_0. *)
(*   simp evaluate_decs; simpl. *)
(*   unfold build_rec_env; unfold nsBind; simpl. *)
(*   reflexivity. *)
(*   unfold extend_dec_env; simpl. *)

(*   unfold dec_def_29_5_6_2_2_2_2_2_2_2_2_1. *)
(*   simp evaluate_decs; simpl. *)
(*   reflexivity. *)
(*   (* ENDS HERE *) *)
(* Qed. *)


Require Import Axioms.
Require Import Tactics.
Require Import Sigma.
Require Import Equality.
Require Import Relation.
Require Import Syntax.
Require Import Ofe.
Require Import Uniform.
Require Import Spaces.
Require Import Dynamic.
Require Import Hygiene.
Require Import Equivalence.
Require Import Urelsp.
Require Import Intensional.
Require Import Ordinal.
Require Import Candidate.
Require Import Ceiling.
Require Import Truncate.
Require Import MapTerm.
Require Import Extend.
Require Import Extend.
Require Export SemanticsProperty.

(* Disoriented rel *)

Definition srel {object} (s : bool) (A : @urel object) i m n :=
  if s then
    rel A i m n
  else
    rel A i n m.

Lemma srel_closed :
  forall object s (A : urel object) i m n,
    srel s A i m n
    -> hygiene clo m /\ hygiene clo n.
Proof.
intros object s A i m n H.
destruct s; so (urel_closed _#5 H) as (? & ?); auto.
Qed.

Lemma srel_equiv :
  forall object s (A : urel object) i m m' n n',
    hygiene clo m'
    -> hygiene clo n'
    -> equiv m m'
    -> equiv n n'
    -> srel s A i m n
    -> srel s A i m' n'.
Proof.
intros object s A i m m' n n' H H0 H1 H2 H3.
destruct s; eapply urel_equiv; eauto.
Qed.

Lemma srel_zigzag :
  forall object s (R : urel object) i m n p q,
    srel s R i m n
    -> srel s R i p n
    -> srel s R i p q
    -> srel s R i m q.
Proof.
intros object s R i m n p q Hmn Hpn Hpq.
destruct s; cbn in *; eapply urel_zigzag; eauto.
apply (urel_zigzag _#4 p n); auto.
Qed.

Lemma srel_downward :
  forall object s A i m n,
    @srel object s A (S i) m n
    -> srel s A i m n.
Proof.
intros object s A i m n H.
destruct s; apply urel_downward; auto.
Qed.

Lemma srel_downward_leq :
  forall object s A i j m n,
    i <= j
    -> @srel object s A j m n
    -> srel s A i m n.
Proof.
intros object s A i m n H.
destruct s; apply urel_downward_leq; auto.
Qed.

Lemma srel_ceiling_intro :
  forall w s i (A : wurel w) j m n,
    j < i
    -> srel s A j m n
    -> srel s (ceiling i A) j m n.
Proof.
intros w s i A j m n Hji Hrel.
destruct s; cbn; cbn in Hrel; auto.
Qed.

Lemma srel_ceiling_elim :
  forall w s i (A : wurel w) j m n,
    srel s (ceiling i A) j m n
    -> srel s A j m n.
Proof.
intros w s i A j m n Hrel.
destruct s; cbn; cbn in Hrel; destruct Hrel; auto.
Qed.

Lemma surel_updown :
  forall v w s (A : wurel v) i m p,
    v <<= w
    -> srel s A i m p
    -> srel s (extend_urel v w A) i (map_term (extend v w) m) (map_term (extend v w) p).
Proof.
intros v w s A i m p Hvw H.
destruct s; apply urel_updown; auto.
Qed.

Definition surelspinj {object} (s : bool) (A : urel object) i m p
  : srel s A i m p -> car (urelsp A)
  :=
  match s
    as s
    return srel s A i m p -> car (urelsp A)
  with
  | true => fun Hmp => urelspinj A i m p Hmp
  | false => fun Hmp => urelspinj A i p m Hmp
  end.

Lemma surelspinj_equal :
  forall object s (A : urel object) i m m' p p' H H',
    srel s A i m p'
    -> surelspinj s A i m p H = surelspinj s A i m' p' H'.
Proof.
intros object s A i m m' p p' Hmp Hmp' H.
destruct s; apply urelspinj_equal; auto.
eapply urel_zigzag; eauto.
Qed.

Lemma surelspinj_equal_impl :
  forall object s (A : urel object) i m m' p p' (H : srel s A i m p) (H' : srel s A i m' p'),
    surelspinj s A i m p H = surelspinj s A i m' p' H'
    -> srel s A i m p'.
Proof.
intros object s A i m m' p p' Hmp Hmp' Heq.
destruct s.
  {
  apply (urelspinj_equal_impl _#7 Hmp Hmp'); auto.
  }

  {
  cbn in * |- *.
  so (urelspinj_equal_impl _#9 Heq).
  eapply urel_zigzag; eauto.
  }
Qed.

Lemma proj_ceiling_surelspinj :
  forall w i j s (A : wurel w) m p Hpos Hmp Hmp',
    proj_ceiling (S i) Hpos A (surelspinj s A j m p Hmp)
    =
    surelspinj s (ceiling (S i) A) (min j i) m p Hmp'.
Proof.
intros w i j s A m p Hpos Hmp Hmp'.
destruct s; cbn; erewrite -> proj_ceiling_urelspinj; eauto.
Qed.

Lemma extend_srel :
  forall v w s A i m p,
    srel s (extend_urel v w A) i m p
    <->
    srel s A i (map_term (extend w v) m) (map_term (extend w v) p).
Proof.
intros v w s A i m p.
destruct s; cbn; split; auto.
Qed.

Lemma extend_surelspinj :
  forall v w (h : v <<= w) s (A : wurel v) i m p Hmp Hmp',
    extend_urelsp h A (surelspinj s A i m p Hmp)
    =
    surelspinj s (extend_urel v w A) i (map_term (extend v w) m) (map_term (extend v w) p) Hmp'.
Proof.
intros v w h s A i m p Hmp Hmp'.
destruct s; apply extend_urelspinj.
Qed.

(* Equality *)

Definition equal_property w (s : bool) (A : wurel w) m n : nat -> Prop :=
  fun i =>
    exists p,
      srel s A i m p
      /\ srel s A i n p.

Lemma equal_property_downward :
  forall w s A m n i,
    equal_property w s A m n (S i)
    -> equal_property w s A m n i.
Proof.
intros w s A m n i H.
destruct H as (p & Hmp & Hnp).
exists p; auto using srel_downward.
Qed.

(* Using a nat instead of a nats will cause trouble if I ever want to make iurels complete. *)

Definition equal_urel (w : ordinal) (s : bool) (i : nat) (A : wurel w) (m n : wterm w) : wurel w :=
  property_urel
    (fun j =>
       exists p,
         srel s A j m p
         /\ srel s A j n p)
    w i
    (equal_property_downward w s A m n).

Lemma equal_urel_equal :
  forall w s i A m m' n n' p q,
    srel s A i m p
    -> srel s A i m' p
    -> srel s A i n q
    -> srel s A i n' q
    -> equal_urel w s i A m n = equal_urel w s i A m' n'.
Proof.
intros w s i A m m' n n' p q Hmp Hmp' Hnq Hnq'.
unfold equal_urel.
apply property_urel_extensionality; auto.
intros j Hj.
cbn in Hj.
assert (j <= i) as Hj' by omega.
split.
  {
  intros (r & Hmr & Hnr).
  exists r.
  split.
    {
    apply (srel_zigzag _#5 p m); eauto using srel_downward_leq.
    }

    {
    apply (srel_zigzag _#5 q n); eauto using srel_downward_leq.
    }
  }

  {
  intros (r & Hmr & Hnr).
  exists r.
  split.
    {
    apply (srel_zigzag _#5 p m'); eauto using srel_downward_leq.
    }

    {
    apply (srel_zigzag _#5 q n'); eauto using srel_downward_leq.
    }
  }
Qed.

Lemma extend_equal_urel :
  forall v w s i A m n,
    v <<= w
    -> extend_urel v w (equal_urel v s i A m n)
       =
       equal_urel w s i (extend_urel v w A) (map_term (extend v w) m) (map_term (extend v w) n).
Proof.
intros v w s i A m n Hle.
unfold equal_urel.
rewrite -> extend_property; auto.
apply property_urel_extensionality; auto.
intros j Hj.
split.
  {
  intros (r & Hmr & Hnr).
  exists (map_term (extend v w) r).
  rewrite -> !extend_srel.
  rewrite -> !extend_term_cancel; auto.
  }

  {
  intros (r & Hmr & Hnr).
  exists (map_term (extend w v) r).
  rewrite -> extend_srel in Hmr, Hnr.
  rewrite -> !extend_term_cancel in Hmr, Hnr; auto.
  }
Qed.

Definition iuequal (w : ordinal) (s : bool) (i : nat) (A : wiurel w) (m n p q : wterm w)
  (Hmp : srel s (den A) i m p) (Hnq : srel s (den A) i n q)
  : wiurel w
  :=
  (equal_urel w s i (den A) m n,
   meta_pair (meta_iurel A)
     (meta_pair
        (meta_term (den A) (surelspinj s (den A) i m p Hmp))
        (meta_term (den A) (surelspinj s (den A) i n q Hnq)))).

(* Trivial, but helpful to control rewriting. *)
Lemma den_iuequal :
  forall w s i A m n p q Hmp Hnq,
    den (iuequal w s i A m n p q Hmp Hnq) = equal_urel w s i (den A) m n.
Proof.
auto.
Qed.

Lemma iuequal_equal :
  forall w s i A m m' n n' p p' q q' Hmp Hmp' Hnq Hnq',
    srel s (den A) i m p'
    -> srel s (den A) i n q'
    -> iuequal w s i A m n p q Hmp Hnq = iuequal w s i A m' n' p' q' Hmp' Hnq'.
Proof.
intros w s i A m m' n n' p p' q q' Hmp Hmp' Hnq Hnq' Hmp'' Hnq''.
unfold iuequal.
f_equal.
  {
  eapply equal_urel_equal; eauto.
  }
f_equal.
f_equal.
  {
  f_equal.
  apply surelspinj_equal.
  eapply srel_zigzag; eauto.
  }

  {
  f_equal.
  apply surelspinj_equal.
  eapply srel_zigzag; eauto.
  }
Qed.

Lemma iuequal_equal' :
  forall w s i A A' m m' n n' p p' q q' Hmp Hmp' Hnq Hnq',
    A = A'
    -> srel s (den A) i m p'
    -> srel s (den A) i n q'
    -> iuequal w s i A m n p q Hmp Hnq = iuequal w s i A' m' n' p' q' Hmp' Hnq'.
Proof.
intros w s i A A' m m' n n' p p' q q' Hmp Hmp' Hnq Hnq' Heq Hmp'' Hnq''.
subst A'.
apply iuequal_equal; auto.
Qed.

Lemma iuequal_inj :
  forall w s i A A' m m' n n' p p' q q' Hmp Hmp' Hnq Hnq',
    iuequal w s i A m n p q Hmp Hnq = iuequal w s i A' m' n' p' q' Hmp' Hnq'
    -> A = A'
       /\ srel s (den A) i m p'
       /\ srel s (den A) i n q'.
Proof.
intros w s i A A' m m' n n' p p' q q' Hmp Hmp' Hnq Hnq' Heq.
unfold iuequal in Heq.
so (f_equal snd Heq) as Heq'.
cbn in Heq'.
so (meta_pair_inj _#5 Heq') as (Heq1 & Heq23).
clear Heq Heq'.
so (meta_iurel_inj _#3 Heq1); subst A'.
so (meta_pair_inj _#5 Heq23) as (Heq2 & Heq3).
clear Heq1 Heq23.
so (meta_term_inj _#5 Heq2) as H.
injectionT H.
intro Heqmp.
so (meta_term_inj _#5 Heq3) as H.
injectionT H.
intro Heqnq.
clear Heq2 Heq3.
do2 2 split; eauto using surelspinj_equal_impl.
Qed.

Lemma iutruncate_iuequal :
  forall w j s i A m n p q Hmp Hnq Hmp' Hnq',
    iutruncate (S j) (iuequal w s i A m n p q Hmp Hnq)
    =
    iuequal w s (min i j) (iutruncate (S j) A) m n p q Hmp' Hnq'.
Proof.
intros w j s i A m n p q Hmp Hnq Hmp' Hnq'.
unfold iuequal, iutruncate.
destruct A as (A & meta).
unfold den.
cbn [fst snd].
f_equal.
  {
  unfold equal_urel.
  cbn [fst].
  rewrite -> ceiling_property.
  apply property_urel_extensionality.
    {
    reflexivity.
    }
  intros k Hk.
  so (Nat.min_glb_r _#3 Hk) as Hkj.
  split.
    {
    intros (r & Hmr & Hnr).
    exists r.
    split; apply srel_ceiling_intro; auto; omega.
    }

    {
    intros (r & Hmr & Hnr).
    exists r.
    eauto using srel_ceiling_elim.
    }
  }

  {
  assert (S j > 0) as Hpos by omega.
  rewrite -> !meta_truncate_pair; auto.
  rewrite -> !(meta_truncate_term _#4 Hpos).
  rewrite -> meta_truncate_iurel; auto.
  f_equal.
  f_equal.
    {
    f_equal.
    apply proj_ceiling_surelspinj.
    }

    {
    f_equal.
    apply proj_ceiling_surelspinj.
    }
  }
Qed.

Lemma extend_iuequal :
  forall v w (h : v <<= w) s i A m n p q Hmp Hmp' Hnq Hnq',
    extend_iurel h (iuequal v s i A m n p q Hmp Hnq)
    =
    iuequal w s i (extend_iurel h A)
      (map_term (extend v w) m)
      (map_term (extend v w) n)
      (map_term (extend v w) p)
      (map_term (extend v w) q)
      Hmp' Hnq'.
Proof.
intros v w h s i A m n p q Hmp Hmp' Hnq Hnq'.
unfold iuequal, extend_iurel.
cbn.
f_equal.
  {
  apply extend_equal_urel; auto.
  }

  {
  rewrite -> !extend_meta_pair.
  rewrite -> extend_meta_iurel.
  rewrite -> !extend_meta_term.
  f_equal.
  f_equal.
    {
    f_equal.
    apply extend_surelspinj.
    }

    {
    f_equal.
    assert (srel s (extend_urel v w (den A)) i (map_term (extend v w) n) (map_term (extend v w) q)) as Hnq''.
      {
      fold (extend_urel v w).
      rewrite -> extend_srel.
      rewrite -> !extend_term_cancel; auto.
      }
    rewrite -> (extend_surelspinj _#9 Hnq'').
    apply surelspinj_equal; auto.
    }
  }
Qed.

Lemma extend_iuequal' :
  forall v w (h : v <<= w) s i A m n p q Hmp Hnq,
    extend_iurel h (iuequal v s i A m n p q Hmp Hnq)
    =
    iuequal w s i (extend_iurel h A)
      (map_term (extend v w) m)
      (map_term (extend v w) n)
      (map_term (extend v w) p)
      (map_term (extend v w) q)
      (surel_updown _#7 h Hmp)
      (surel_updown _#7 h Hnq).
Proof.
intros v w h s i A m n p q Hmp Hnq.
apply extend_iuequal.
Qed.

Lemma srel_swap :
  forall object s (A : urel object) i m n,
    srel s A i m n
    -> srel (negb s) A i n m.
Proof.
intros object s A i m n H.
destruct s; auto.
Qed.

Lemma srel_unswap :
  forall object s (A : urel object) i m n,
    srel (negb s) A i n m
    -> srel s A i m n.
Proof.
intros object s A i m n H.
destruct s; auto.
Qed.

Lemma surelspinj_swap :
  forall object s (A : urel object) i m p Hmp Hpm,
    surelspinj s A i m p Hmp
    =
    surelspinj (negb s) A i p m Hpm.
Proof.
intros object s A i m p Hmp Hpm.
destruct s; cbn.
  {
  f_equal.
  apply proof_irrelevance.
  }

  {
  f_equal.
  apply proof_irrelevance.
  }
Qed.

Lemma iuequal_swap :
  forall w s i A m n p q Hmp Hnq,
    iuequal w s i A m n p q Hmp Hnq
    =
    iuequal w (negb s) i A p q m n (srel_swap _#6 Hmp) (srel_swap _#6 Hnq).
Proof.
intros w s i A m n p q Hmp Hnq.
unfold iuequal.
f_equal.
  {
  apply property_urel_extensionality; auto.
  intros j Hj.
  cbn in Hj.
  assert (j <= i) as Hj' by omega.
  split.
    {
    intros (r & Hmr & Hnr).
    exists m; split; apply srel_swap.
      {
      exact (srel_downward_leq _#7 Hj' Hmp).
      }

      {
      refine (srel_zigzag _#8 Hmr Hnr _).
      exact (srel_downward_leq _#7 Hj' Hnq).
      }
    }

    {
    intros (r & Hpr & Hqr).
    so (srel_unswap _#6 Hpr) as Hrp.
    so (srel_unswap _#6 Hqr) as Hrq.
    exists p.
    split.
      {
      exact (srel_downward_leq _#7 Hj' Hmp).
      }

      {
      refine (srel_zigzag _#8 _ Hrq Hrp).
      exact (srel_downward_leq _#7 Hj' Hnq).
      }
    }
  }

  {
  f_equal.
  f_equal.
    {
    f_equal.
    apply surelspinj_swap.
    }

    {
    f_equal.
    apply surelspinj_swap.
    }
  }
Qed.


From Equations Require Import Equations.
Require Import Coq.Lists.List.
Import ListNotations.

Require Export SystemFR.ErasedTypeRefine.
Require Export SystemFR.ErasedArrow.
Require Export SystemFR.ErasedTypeApplication.

Require Export SystemFR.ReducibilityEquivalent.

Opaque reducible_values.
Opaque makeFresh.

Definition type_open T1 T2 : tree :=
  T_exists T2 (shift_open 0 T1 (lvar 0 term_var)).

(*
Definition equivalent_terms_at (theta: interpretation) T t1 t2 :=
  is_erased_term t1 /\
  is_erased_term t2 /\
  wf t1 0 /\
  wf t2 0 /\
  pfv t1 term_var = nil /\
  pfv t2 term_var = nil /\
  forall C,
    (forall v, reducible_values theta v T ->
          div_reducible theta (open 0 C v) T_top) ->
    is_erased_term C ->
    wf C 1 ->
    pfv C term_var = nil ->
    scbv_normalizing (open 0 C t1) <-> scbv_normalizing (open 0 C t2).
*)
(*
Lemma singleton_identity:
  is_singleton [] []
    (notype_lambda (lvar 0 term_var))
    (T_arrow T_nat (singleton (lvar 0 term_var))).
Proof.
  unfold is_singleton;
    repeat step || simp_red;
    t_closer.

  - unfold reduces_to; steps; t_closer.
    exists a; repeat step || simp_red || rewrite open_none by auto; t_closer.
    + exists uu; repeat step || simp_red; eauto using equivalent_refl.

    + apply star_one.
      constructor; t_closer.

  - unfold equivalent_terms_at;
      repeat step;
      t_closer.
*)

Definition sub_singleton tvars gamma v T : Prop :=
  forall theta l v',
    valid_interpretation theta ->
    satisfies (reducible_values theta) gamma l  ->
    support theta = tvars ->
    reducible_values theta v' (psubstitute T l term_var) ->
    equivalent_terms v' (psubstitute v l term_var).

Lemma reducibility_open_equivalent2:
  forall T t1 t2 ρ t,
    [ ρ ⊨ t : open 0 T t1 ] ->
    valid_interpretation ρ ->
    is_erased_type T ->
    wf T 1 ->
    pfv T term_var = nil ->
    [ t1 ≡ t2 ] ->
    [ ρ ⊨ t : open 0 T t2 ].
Proof.
  eauto using reducibility_open_equivalent, reducible_values_exprs.
Qed.

Lemma open_subtype_type_application:
  forall tvars gamma A B C c,
    wf A 0 ->
    wf B 1 ->
    wf C 0 ->
    wf c 0 ->
    is_erased_term c ->
    is_erased_type A ->
    is_erased_type B ->
    is_erased_type C ->
    subset (fv A) (support gamma) ->
    subset (fv B) (support gamma) ->
    subset (fv C) (support gamma) ->
    subset (fv c) (support gamma) ->
    sub_singleton tvars gamma c C ->
    [ tvars; gamma ⊨ C <: A ] ->
    [ tvars; gamma ⊨ type_application (T_arrow A B) C <: open 0 B c ].
Proof.
  unfold open_subtype;
    repeat step || simp_red ||
           (rewrite open_none in * by eauto with wf) ||
           (rewrite (open_none v) in * by t_closer) ||
           (rewrite (open_none (psubstitute C l term_var) 1) in * by eauto with wf).

  apply reducible_expr_value; t_closer.

  eapply reducibility_equivalent2; try eassumption;
    repeat step ||
           apply wf_open || apply wf_subst ||
           apply is_erased_type_open || apply subst_erased_type;
    t_closer.

  - apply fv_nils2; eauto with fv.
    eapply subset_transitive; eauto using fv_open;
      repeat step || sets;
      t_closer.

  - t_substitutions.
    apply reducibility_open_equivalent2 with a0;
      repeat step || apply_any; t_closer.
Qed.

Lemma sub_singleton_value:
  forall v T,
    closed_value v ->
    sub_singleton [] [] v (T_singleton T v).
Proof.
  unfold sub_singleton;
    repeat step || simp_red ||
           (rewrite open_none in * by t_closer) ||
           (rewrite shift_nothing2 in * by t_closer).
Qed.


From mathcomp Require Import ssreflect ssrfun.
Require Import all_ntrvw.
Import Morphisms.
Require Import FunctionalExtensionality.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Module dictionary.
  Record mixin_of Q A (conv: Q ->> A) :=
    Mixin {
        answers_unique: conv \is_singlevalued;
        }.

  Record class_of (I: Type) :=
    Class {
        M: interview.struc_of I;
        mixin: mixin_of (conversation (interview.Pack M));
        }.

  Structure type :=
    Pack {I; struc : class_of I}.
End dictionary.

Section dictionaries.
  Local Notation dictionary:= dictionary.type.
  Local Coercion dictionary.struc: dictionary >-> dictionary.class_of.
  Local Coercion dictionary.mixin: dictionary.class_of >-> dictionary.mixin_of.
  Local Coercion dictionary.M: dictionary.class_of >-> interview.struc_of.
  Local Notation description := conversation.
  Local Notation "a '\is_answer_to' q 'in' D" := (description D q a) (at level 2).
  Local Notation "a \is_answer_to q" := (a \is_answer_to  q in _) (at level 2).

  Lemma answers_unique (D: dictionary): (description D) \is_singlevalued.
  Proof. by case: D => A [Q []]. Qed.

  Local Notation answer_unique := answers_unique.

  Definition lift_ntrvw (I: interview) (sing: (conversation I) \is_singlevalued): dictionary:=
    dictionary.Pack (dictionary.Class (dictionary.Mixin sing)).

  Lemma id_sing S: (@mf_id S) \is_singlevalued.
  Proof. exact/F2MF_sing. Qed.
  Definition id_dictionary (S: Type): dictionary := @lift_ntrvw (id_interview S) (@id_sing S).
  Definition get_ntrvw (D: dictionary):= interview.Pack (interview.Struc (dictionary.M D)).

  Context  (D D': dictionary).
  Local Coercion get_ntrvw: dictionary >-> interview.

  Lemma prod_conv_sing: (prod_conv D D') \is_singlevalued.
  Proof. exact/fprd_sing/answer_unique/answer_unique. Qed.

  Definition prod_dictionary_mixin : dictionary.mixin_of (prod_conv D D'):=
    dictionary.Mixin prod_conv_sing.

  Canonical prod_dictionary_struc:= dictionary.Class prod_dictionary_mixin.
  Canonical prod_dictionary:= dictionary.Pack prod_dictionary_struc.

  Lemma sum_conv_sing: (sum_conv D D') \is_singlevalued.
  Proof. exact/fsum_sing/answer_unique/answer_unique. Qed.

  Definition sum_dictionary_mixin: dictionary.mixin_of (sum_conv D D'):=
    dictionary.Mixin sum_conv_sing.

  Canonical sum_dictionary_struc:= dictionary.Class sum_dictionary_mixin.
  Canonical sum_dictionary:= dictionary.Pack sum_dictionary_struc.

  Lemma map_sing S T (f: S ->> T): f \is_singlevalued -> (mf_map f) \is_singlevalued.
  Proof.
    move => sing L K K'.
    elim : L K K' => [ | q L ih]; first by case => //; case.
    case => // a K; case => // a' K' /=[fqa lst] [fqa' lst'].
    rewrite (sing q a a' fqa fqa'); f_equal.
    exact/ih.
  Qed.

  Lemma list_conv_sing: (list_conv D) \is_singlevalued.
  Proof. exact/map_sing/answers_unique. Qed.

  Definition list_dictionary_mixin: dictionary.mixin_of (list_conv D):=
    dictionary.Mixin list_conv_sing.

  Canonical list_dictionary_struc:= dictionary.Class list_dictionary_mixin.
  Canonical list_dictionary:= dictionary.Pack list_dictionary_struc.

  Lemma rlzr_spec F f: F \realizes (f: get_ntrvw D ->> get_ntrvw D')
                       <-> ((conversation D') \o F) \tightens (f \o (conversation D)).
  Proof.
    split => [Frf | tight].
    apply split_tight => q [a' [[a [aaq faa']] subs]].
    - have [[q' Fqq'] prp]:= Frf q a aaq (subs a aaq).
      have [d' [d'aq' fad']]:= prp q' Fqq'.
      exists d'; split => [ | r' Fqr']; first by exists q'.
      by have [e' [e'aq' fae']]:= prp r' Fqr'; exists e'.
    move => d' [[q' [Fqq' d'aq']] subs'].
    split => [ | d daq]; last exact/subs.
    - have [d'' [d''aq' fad'']]:= rlzr_val Frf aaq (subs a aaq) Fqq'.
      by exists a; split => //; rewrite (answers_unique d'aq' d''aq').
    move => q a aaq [a' faa'].
    have qfd: q \from dom (f \o (conversation D)).
    - exists a'; split => [ | d daq]; first by exists a.
      by exists a'; rewrite (answer_unique daq aaq).
    split => [ | q' Fqq'].
    - by have [ | d' [[q' [Fqq' d'aq']] subs]]:= (tight_dom tight) q; last by exists q'.
    have [d' [[z' [Fqz' d'az']] subs]]:= (tight_dom tight) q qfd; have [e' e'aq']:= subs q' Fqq'.
    have [ | [d [daq fdd']] subs']:= (tight_val tight qfd) e'; first by split; first by exists q'.
    by exists e'; rewrite (answers_unique aaq daq); first split.
  Qed.
End dictionaries.
Notation dictionary:= dictionary.type.
Coercion dictionary.struc: dictionary >-> dictionary.class_of.
Coercion dictionary.mixin: dictionary.class_of >-> dictionary.mixin_of.
Coercion get_ntrvw: dictionary >-> interview.
Notation description := conversation.
Notation "a '\is_answer_to' q 'in' D" := (description D q a) (at level 2).
Notation "a \is_answer_to q" := (a \is_answer_to  q in _) (at level 2).
Notation answer_unique := answers_unique.

Section mf_realizer.
  Context (D: dictionary) (I: interview).

  Lemma rlzr_F2MF_eq F (f g: answers I -> answers D):
    F \realizes (F2MF f) -> F \realizes (F2MF g) -> f =1 g.
  Proof.
    move => rlzr rlzr' a.
    have [q arq]:= conv_sur a.
    have [ | Fq FqFq]:= rlzr_dom rlzr arq; first exact/F2MF_dom.
    have [ | fa [farFq ->]]:= rlzr_val rlzr arq _ FqFq; first exact/F2MF_dom.
    have [ | ga [garFq ->]]:= rlzr_val rlzr' arq _ FqFq; first exact/F2MF_dom.
    by rewrite (@answers_unique D Fq fa ga).
  Qed.

  Lemma rlzr_sur: (@mf_rlzr D I) \is_cototal.
  Proof.
    move => f.
    exists (make_mf (fun q Fq => forall a, a \is_response_to q -> exists fa, fa \is_response_to Fq /\ f a fa)).
    move => q a qna [fa fafa]; split => [ | Fq FqFq]; last by have [a' []]:= FqFq a qna; exists a'.
    have [Fq Fqnfa]:= conv_sur fa; exists Fq => a' qna'.
    by exists fa; split => //; rewrite (@answers_unique D q a' a).
  Qed.

  Definition rlzrs_interview_mixin:= interview.Mixin rlzr_sur.
  Canonical rlzrs_interview_struc:= interview.Struc rlzrs_interview_mixin.
  Canonical rlzrs_interview:= interview.Pack rlzrs_interview_struc.
  End mf_realizer.