Qed.
Hint Rewrite refineFunCorrect.
Hint Unfold refineFunction.
Program Fixpoint addToTree (st : SeedTree) (p : SplitPath) (f : SplitPath -> RandomSeed)
(l : list SplitPath)
(Corr : correspondingSeedTree l f st)
(Pref : forall p', In p' l -> (forall p1 p2, p ++ p1 = p' ++ p2 -> False))
: SeedTree :=
match st with
| SeedTreeUndef =>
match p with
| [] => SeedTreeLeaf (f p)
| Left  :: p' => SeedTreeNode (addToTree SeedTreeUndef p' (refineFunction f Left) [] _ _) SeedTreeUndef
| Right :: p' => SeedTreeNode SeedTreeUndef (addToTree SeedTreeUndef p' (refineFunction f Right) [] _ _)
end
| SeedTreeLeaf s => _  (* Contradiction! *)
| SeedTreeNode st1 st2 =>
match p with
| [] => SeedTreeLeaf (f p)
| Left  :: p' => SeedTreeNode (addToTree st1 p' (refineFunction f Left) (refineList Left l) _ _) st2
| Right :: p' => SeedTreeNode st1 (addToTree st2 p' (refineFunction f Right) (refineList Right l) _ _)
end
end.
Next Obligation.
apply corrEmptyLeaf in Corr. inversion Corr; clear Corr; subst.
pose proof (Pref []).
exfalso.
eapply H.
+ left; auto.
+ instantiate (2 := []). rewrite app_nil_r. simpl. eauto.
Qed.
Next Obligation.
eapply Corresponding; intros.
+ apply refineCorrect'.
inversion Corr as [Vary_In _ _ ]; clear Corr.
pose proof (Vary_In (Left :: p) s) as Hyp; clear Vary_In.
auto.
+ apply refineCorrect in H.
inversion Corr as [_ In_Vary _]; clear Corr.
pose proof (In_Vary (Left :: p)) as Hyp; clear In_Vary.
apply Hyp in H; clear Hyp.
simpl in H.
unfold refineFunction; auto.
+ inversion Corr.
apply refinePreservesPrefixFree.
auto.
Qed.
Next Obligation.
eapply Pref.
instantiate (1:= Left :: p'0).
apply refineCorrect; auto.
instantiate (1:= p2). instantiate (1:=p1). simpl. rewrite H0. auto.
Qed.
Next Obligation.
eapply Corresponding; intros.
+ apply refineCorrect'.
inversion Corr as [Vary_In _ _ ]; clear Corr.
pose proof (Vary_In (Right :: p) s) as Hyp; clear Vary_In.
auto.
+ apply refineCorrect in H.
inversion Corr as [_ In_Vary _]; clear Corr.
pose proof (In_Vary (Right :: p)) as Hyp; clear In_Vary.
apply Hyp in H; clear Hyp.
simpl in H.
unfold refineFunction; auto.
+ inversion Corr.
apply refinePreservesPrefixFree.
auto.
Qed.
Next Obligation.
eapply Pref.
instantiate (1:= Right :: p'0).
apply refineCorrect; auto.
instantiate (1:= p2). instantiate (1:=p1). simpl. rewrite H0. auto.
Qed.

(* Specifications: *)
Lemma addToTreeCorrect1 : forall (st : SeedTree) (p : SplitPath)
(f : SplitPath -> RandomSeed)
(l : list SplitPath) (Corr : correspondingSeedTree l f st)
(Pref : forall p', In p' l -> (forall p1 p2, p ++ p1 = p' ++ p2 -> False)),
varySeed' (addToTree st p f l Corr Pref) p = Some (f p).