Section tbled.
Variable tbl : SymEnv.functions RType_typ.
Let RSym_sym := RSym_sym tbl.
Existing Instance RSym_sym.
Let RSym_sym_ok :  RSymOk RSym_sym := _.
Existing Instance RSym_sym_ok.
Let Expr_expr_fs := Expr_expr_fs tbl.
Existing Instance Expr_expr_fs.
Let Expr_ok_fs := Expr_ok_fs tbl.
Existing Instance Expr_ok_fs.
Existing Instance MA.
Definition reflect tus tvs e (ty : typ)
:= @exprD _ _ _ Expr_expr_fs tus tvs e ty.
intros. congruence.
Qed.
intros.
unfold as_tree in H.
repeat
match goal with
| [ H : match ?x with _ => _  end = _ |- _ ] => destruct x;
try (apply some_none in H; contradiction) end.
congruence.
inversion H. subst. auto.
Admitted. (*Qed.*)
intros.
unfold as_tree in H.
repeat
match goal with
| [ H : match ?x with _ => _  end = _ |- _ ] => destruct x; simpl in H;  try congruence end.
inversion H. subst. auto.
Admitted.
Ltac destruct_as_tree :=
repeat
match goal with
| [ H : context [ match as_tree ?x with _ => _ end] |- _] => destruct (as_tree x) eqn:?
| [ H : as_tree _ = Some (inl (_ , _ , _, _)) |- _ ] => apply as_tree_l in H
| [ H : as_tree _ = Some (inr _) |- _ ] => apply as_tree_r in H
| [ H : as_tree _ = Some (inl (?p, _, _)) |- _ ] => destruct p
| [ H : as_tree _ = Some (inl (?p, _)) |- _ ] => destruct p
| [ H : as_tree _ = Some (inl ?p) |- _ ] => destruct p
| [ H : as_tree _ = Some ?p |- _ ] => destruct p
end;
subst.
Ltac solve_exprD := solve_exprD.solve_exprD tbl.
Opaque type_cast.
unfold RSym_sym.
induction i; intros; simpl in *;
destruct (as_tree tr) eqn:?; destruct_as_tree; solve_exprD; unfold none_reif; solve_exprD.
Qed.
(*Qed.*)
Ltac extract_set_reif_type :=
repeat
match goal with
| [ H : exprD' ?tus ?tvs (typtree ?t) (set_reif _ _ _ _) = _ |- _] => fail 1
| [ H : exprD' ?tus ?tvs ?t (set_reif ?i ?vr ?e ?t0) = Some ?x |- _] =>
pose proof (set_reif_istree i tus tvs t vr e t0 x H); subst; try congruence
end.
Ltac set_reif_ex :=
match goal with
|  [ H : exprD' ?tus ?tvs (typtree ?t) (set_reif ?i ?vr ?e ?t) = None |- _ ] =>
edestruct (set_reif_exprD tus tvs t i vr e); eauto; fold func in *;
try congruence
| [ H : context[match typeof_expr ?tus ?tvs (set_reif ?i ?vr ?e ?t) with _ => _ end ] |- _ ] =>
edestruct (set_reif_exprD tus tvs t i vr e); eauto; pose_types; fold func in *;  forward
end.
intros.
edestruct (set_reif_exprD); eauto.
instantiate (1 := i) in H2.
solve_exprD. unfold RSym_sym in *.
fold func in *. congruence.
Qed.
Ltac set_typeof_None :=
match goal with
| [H: typeof_expr ?tus ?tvs (set_reif ?i ?vr ?e ?t) = None |- _ ] =>
try solve [eapply typeof_set_reif_None_F in H; first [progress eauto | solve_exprD]; try contradiction]
end.
Ltac get_vr_type :=
repeat
match goal with
|  [ H :  exprD' ?tus ?tvs (typtree ?typ) (set_reif ?i ?vr ?e ?typ) = Some ?v |- _ ] =>
match goal with
| [ H': exprD' tus tvs typ vr = Some _ |- _] => fail 1
| _ => destruct (set_reif_vr _ _ typ _ _ _ _ H)
end
end.
Ltac set_reif_tac :=
repeat (unfold RSym_sym in *;
solve_exprD;
try set_reif_ex;
extract_set_reif_type;
try set_typeof_None;
try (progress get_vr_type; pose_types tbl)
).

Lemma set_reif_eq2 :
forall i tus tvs typ vr tr val,
exprD' tus tvs (typtree typ) tr = Some val ->
exprD' tus tvs (typtree typ) (App (App (Inj (inr (Data (fset typ i)))) vr) tr)  =
exprD' tus tvs (typtree typ) (set_reif i vr tr typ).